1 package SQL::Translator::Parser::SqlfXML;
3 # -------------------------------------------------------------------
4 # $Id: SqlfXML.pm,v 1.6 2003-08-20 22:50:30 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::SqlfXML - parser for the XML produced by
26 SQL::Translator::Producer::SqlfXML.
31 use SQL::Translator::Parser::SqlfXML;
33 my $translator = SQL::Translator->new(
37 print = $obj->translate(
40 filename => "fooschema.xml",
45 A SQL Translator parser to parse the XML files produced by its SqftXML producer.
46 The XML must be in the namespace 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 --from=MySQL --to=SqftXML foo_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.
84 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
85 $VERSION = sprintf "%d.%02d", q$Revision: 1.6 $ =~ /(\d+)\.(\d+)/;
86 $DEBUG = 0 unless defined $DEBUG;
90 use base qw(Exporter);
91 @EXPORT_OK = qw(parse);
93 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
95 use XML::XPath::XMLParser;
98 warn @_,"\n" if $DEBUG;
102 my ( $translator, $data ) = @_;
103 my $schema = $translator->schema;
104 local $DEBUG = $translator->debug;
105 #local $TRACE = $translator->trace ? 1 : undef;
106 # Nothing with trace option yet!
108 my $xp = XML::XPath->new(xml => $data);
109 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
111 # Work our way through the tables
113 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
115 sort { "".$xp->findvalue('sqlf:order',$a)
116 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
118 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
119 my $table = $schema->add_table(
120 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
121 ) or die $schema->error;
125 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
127 sort { ("".$xp->findvalue('sqlf:order',$a) || 0)
128 <=> ("".$xp->findvalue('sqlf:order',$b) || 0) } @nodes
130 my %fdata = get_tagfields($xp, $_, "sqlf:",
131 qw/name data_type size default_value is_nullable is_auto_increment
132 is_primary_key is_foreign_key comments/);
133 if (exists $fdata{default_value} and defined $fdata{default_value}){
134 if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) {
135 $fdata{default_value}= undef;
137 elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) {
138 $fdata{default_value} = "";
141 my $field = $table->add_field(%fdata) or die $schema->error;
142 $table->primary_key($field->name) if $fdata{'is_primary_key'};
143 # TODO We should be able to make the table obj spot this when we
145 # TODO Deal with $field->extra
150 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
152 my %data = get_tagfields($xp, $_, "sqlf:",
153 qw/name type table fields reference_fields reference_table
154 match_type on_delete_do on_update_do/);
155 $table->add_constraint(%data) or die $schema->error;
160 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
162 my %data = get_tagfields($xp, $_, "sqlf:",
163 qw/name type fields options/);
164 $table->add_index(%data) or die $schema->error;
172 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
173 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
175 # Returns hash of data. If a tag isn't in the file it is not in this
177 # TODO Add handling of and explicit NULL value.
179 my ($xp, $node, @names) = @_;
182 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
183 my $thisns = (s/(^.*?:)// ? $1 : $ns);
184 foreach my $path ( "\@$thisns$_","$thisns$_") {
185 $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
186 debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
189 return wantarray ? %data : \%data;
200 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also
201 false. This is a bit counter intuative for some tags as seeing
202 <sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
203 be. So for now it is safest not to use them until their handling by the parser
208 * Support sqf:options.
209 * Test forign keys are parsed ok.
210 * Sort out sane handling of empty tags <foo/> vs tags with no content
211 <foo></foo> vs it no tag being there.
212 * Control over defaulting of non-existant tags.
216 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
220 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
221 SQL::Translator::Schema.