1 package SQL::Translator::Parser::SqlfXML;
3 # -------------------------------------------------------------------
4 # $Id: SqlfXML.pm,v 1.5 2003-08-15 15:08:08 grommit 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.
85 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
86 $VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/;
87 $DEBUG = 0 unless defined $DEBUG;
91 use base qw(Exporter);
92 @EXPORT_OK = qw(parse);
94 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
96 use XML::XPath::XMLParser;
99 warn @_,"\n" if $DEBUG;
103 my ( $translator, $data ) = @_;
104 my $schema = $translator->schema;
105 local $DEBUG = $translator->debug;
106 #local $TRACE = $translator->trace ? 1 : undef;
107 # Nothing with trace option yet!
109 my $xp = XML::XPath->new(xml => $data);
110 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
112 # Work our way through the tables
114 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
116 sort { "".$xp->findvalue('sqlf:order',$a)
117 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
119 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
120 my $table = $schema->add_table(
121 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
122 ) or die $schema->error;
126 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
128 sort { ("".$xp->findvalue('sqlf:order',$a) || 0)
129 <=> ("".$xp->findvalue('sqlf:order',$b) || 0) } @nodes
131 my %fdata = get_tagfields($xp, $_, "sqlf:",
132 qw/name data_type size default_value is_nullable is_auto_increment
133 is_primary_key is_foreign_key comments/);
134 if (exists $fdata{default_value} and defined $fdata{default_value}){
135 if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) {
136 $fdata{default_value}= undef;
138 elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) {
139 $fdata{default_value} = "";
142 my $field = $table->add_field(%fdata) or die $schema->error;
143 $table->primary_key($field->name) if $fdata{'is_primary_key'};
144 # TODO We should be able to make the table obj spot this when we
146 # TODO Deal with $field->extra
151 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
153 my %data = get_tagfields($xp, $_, "sqlf:",
154 qw/name type table fields reference_fields reference_table
155 match_type on_delete_do on_update_do/);
156 $table->add_constraint(%data) or die $schema->error;
161 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
163 my %data = get_tagfields($xp, $_, "sqlf:",
164 qw/name type fields options/);
165 $table->add_index(%data) or die $schema->error;
173 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
174 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
176 # Returns hash of data. If a tag isn't in the file it is not in this
178 # TODO Add handling of and explicit NULL value.
180 my ($xp, $node, @names) = @_;
183 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
184 my $thisns = (s/(^.*?:)// ? $1 : $ns);
185 foreach my $path ( "\@$thisns$_","$thisns$_") {
186 $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
187 debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
190 return wantarray ? %data : \%data;
201 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also
202 false. This is a bit counter intuative for some tags as seeing
203 <sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
204 be. So for now it is safest not to use them until their handling by the parser
209 * Support sqf:options.
210 * Test forign keys are parsed ok.
211 * Sort out sane handling of empty tags <foo/> vs tags with no content
212 <foo></foo> vs it no tag being there.
213 * Control over defaulting of non-existant tags.
217 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
221 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
222 SQL::Translator::Schema.