1 package SQL::Translator::Parser::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.1 2003-08-22 18:01:50 kycl4rk Exp $
5 # -------------------------------------------------------------------
6 # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>,
8 # This program is free software; you can redistribute it and/or
9 # modify it under the terms of the GNU General Public License as
10 # published by the Free Software Foundation; version 2.
12 # This program is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
15 # General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with this program; if not, write to the Free Software
19 # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
21 # -------------------------------------------------------------------
25 SQL::Translator::Parser::XML::SQLFairy - parser for SQL::Translator's XML
30 use SQL::Translator::Parser::XML::SQLFairy;
32 my $translator = SQL::Translator->new(
33 from => 'XML-SQLFairy',
35 filename => 'schema.xml',
40 print $obj->translate;
44 This parser handles the flavor of XML used natively by the SQLFairy
45 project (SQL::Translator). The XML must be in the namespace
46 "http://sqlfairy.sourceforge.net/sqlfairy.xml."
48 To see an example of the XML translate one of your schema :) e.g.
50 $ sql_translator.pl -f MySQL -t XML-SQLFairy schema.sql
54 The parser will happily parse XML produced with the attrib_values arg set. If
55 it sees a value set as an attribute and a tag, the tag value will override
56 that of the attribute.
58 e.g. For the xml below the table would get the name 'bar'.
60 <sqlf:table name="foo">
66 Leave the tag out all together to use the default in Schema::Field. Use empty
67 tags or EMPTY_STRING for a zero lenth string. NULL for an explicit null
68 (currently sets default_value to undef in the Schema::Field obj).
70 <sqlf:default_value></sqlf:default_value> <!-- Empty string -->
71 <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
72 <sqlf:default_value>NULL</sqlf:default_value> <!-- NULL -->
74 <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
78 Doesn't take any extra parser args at the moment.
82 # -------------------------------------------------------------------
86 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
87 $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
88 $DEBUG = 0 unless defined $DEBUG;
92 use base qw(Exporter);
93 @EXPORT_OK = qw(parse);
95 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
97 use XML::XPath::XMLParser;
100 warn @_,"\n" if $DEBUG;
104 my ( $translator, $data ) = @_;
105 my $schema = $translator->schema;
106 local $DEBUG = $translator->debug;
107 #local $TRACE = $translator->trace ? 1 : undef;
108 # Nothing with trace option yet!
110 my $xp = XML::XPath->new(xml => $data);
111 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
113 # Work our way through the tables
115 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
117 sort { "".$xp->findvalue('sqlf:order',$a)
118 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
120 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
121 my $table = $schema->add_table(
122 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
123 ) or die $schema->error;
127 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
129 sort { ("".$xp->findvalue('sqlf:order',$a) || 0)
130 <=> ("".$xp->findvalue('sqlf:order',$b) || 0) } @nodes
132 my %fdata = get_tagfields($xp, $_, "sqlf:",
133 qw/name data_type size default_value is_nullable is_auto_increment
134 is_primary_key is_foreign_key comments/);
135 if (exists $fdata{default_value} and defined $fdata{default_value}){
136 if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) {
137 $fdata{default_value}= undef;
139 elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) {
140 $fdata{default_value} = "";
143 my $field = $table->add_field(%fdata) or die $schema->error;
144 $table->primary_key($field->name) if $fdata{'is_primary_key'};
145 # TODO We should be able to make the table obj spot this when we
147 # TODO Deal with $field->extra
152 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
154 my %data = get_tagfields($xp, $_, "sqlf:",
155 qw/name type table fields reference_fields reference_table
156 match_type on_delete_do on_update_do/);
157 $table->add_constraint(%data) or die $schema->error;
162 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
164 my %data = get_tagfields($xp, $_, "sqlf:",
165 qw/name type fields options/);
166 $table->add_index(%data) or die $schema->error;
174 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
175 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
177 # Returns hash of data. If a tag isn't in the file it is not in this
179 # TODO Add handling of and explicit NULL value.
181 my ($xp, $node, @names) = @_;
184 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
185 my $thisns = (s/(^.*?:)// ? $1 : $ns);
186 foreach my $path ( "\@$thisns$_","$thisns$_") {
187 $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
188 debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
191 return wantarray ? %data : \%data;
196 # -------------------------------------------------------------------
202 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and
203 hence also false. This is a bit counter intuative for some tags as
204 seeing <sqlf:is_nullable /> you might think that it was set when it
205 fact it wouldn't be. So for now it is safest not to use them until
206 their handling by the parser is defined.
212 =item * Support sqf:options.
214 =item * Test forign keys are parsed ok.
216 =item * Sort out sane handling of empty tags <foo/> vs tags with no content
217 <foo></foo> vs it no tag being there.
219 =item * Control over defaulting of non-existant tags.
225 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
229 perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
230 SQL::Translator::Schema.