1 package SQL::Translator::Parser::SqlfXML;
3 # -------------------------------------------------------------------
4 # $Id: SqlfXML.pm,v 1.4 2003-08-07 15:03:30 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 and example of the XML translate one of your schema :) e.g.
50 $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql
54 Leave the tag out all together to use the default in Schema::Field. Use empty
55 tags or EMPTY_STRING for a zero lenth string. NULL for an explicit null
56 (currently sets default_value to undef Schema::Field).
58 <sqlf:default_value></sqlf:default_value> <!-- Empty string -->
59 <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
60 <sqlf:default_value>NULL</sqlf:default_value> <!-- NULL -->
62 <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
69 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
70 $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
71 $DEBUG = 0 unless defined $DEBUG;
75 use base qw(Exporter);
76 @EXPORT_OK = qw(parse);
78 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
80 use XML::XPath::XMLParser;
83 warn @_,"\n" if $DEBUG;
87 my ( $translator, $data ) = @_;
88 my $schema = $translator->schema;
89 local $DEBUG = $translator->debug;
90 #local $TRACE = $translator->trace ? 1 : undef;
91 # Nothing with trace option yet!
93 my $xp = XML::XPath->new(xml => $data);
94 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
96 # Work our way through the tables
98 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
100 sort { "".$xp->findvalue('sqlf:order',$a)
101 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
103 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
104 my $table = $schema->add_table(
105 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
106 ) or die $schema->error;
110 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
112 sort { "".$xp->findvalue('sqlf:order',$a)
113 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
115 my %fdata = get_tagfields($xp, $_, "sqlf:",
116 qw/name data_type size default_value is_nullable is_auto_increment
117 is_primary_key is_foreign_key comments/);
118 if (exists $fdata{default_value} and defined $fdata{default_value}){
119 if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) {
120 $fdata{default_value}= undef;
122 elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) {
123 $fdata{default_value} = "";
126 my $field = $table->add_field(%fdata) or die $schema->error;
127 $table->primary_key($field->name) if $fdata{'is_primary_key'};
128 # TODO We should be able to make the table obj spot this when we
130 # TODO Deal with $field->extra
135 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
137 my %data = get_tagfields($xp, $_, "sqlf:",
138 qw/name type table fields reference_fields reference_table
139 match_type on_delete_do on_update_do/);
140 $table->add_constraint(%data) or die $schema->error;
145 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
147 my %data = get_tagfields($xp, $_, "sqlf:",
148 qw/name type fields options/);
149 $table->add_index(%data) or die $schema->error;
157 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
158 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
160 # Returns hash of data. If a tag isn't in the file it is not in this
162 # TODO Add handling of and explicit NULL value.
164 my ($xp, $node, @names) = @_;
167 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
168 my $path = (s/(^.*?:)// ? $1 : $ns).$_;
169 $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node);
170 debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF");
172 return wantarray ? %data : \%data;
183 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also
184 false. This is a bit counter intuative for some tags as seeing
185 <sqlf:is_nullable /> you might think that it was set when it fact it wouldn't
186 be. So for now it is safest not to use them until their handling by the parser
191 * Support sqf:options.
192 * Test forign keys are parsed ok.
193 * Sort out sane handling of empty tags <foo/> vs tags with no content
194 <foo></foo> vs it no tag being there.
195 * Control over defaulting of non-existant tags.
199 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
203 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
204 SQL::Translator::Schema.