1 package SQL::Translator::Parser::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.4 2003-10-20 14:26:01 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::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 $ sqlt -f MySQL -t XML-SQLFairy schema.sql
54 The parser will happily parse XML produced with the attrib_values arg
55 set. If it sees a value set as an attribute and a tag, the tag value
56 will override 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.
67 Use empty tags or EMPTY_STRING for a zero lenth string. NULL for an
68 explicit null (currently sets default_value to undef in the
71 <sqlf:default_value></sqlf:default_value> <!-- Empty string -->
72 <sqlf:default_value>EMPTY_STRING</sqlf:default_value> <!-- Empty string -->
73 <sqlf:default_value>NULL</sqlf:default_value> <!-- NULL -->
75 <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS -->
79 Doesn't take any extra parser args at the moment.
83 # -------------------------------------------------------------------
87 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
88 $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/;
89 $DEBUG = 0 unless defined $DEBUG;
93 use base qw(Exporter);
94 @EXPORT_OK = qw(parse);
96 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
97 use SQL::Translator::Utils 'debug';
99 use XML::XPath::XMLParser;
102 my ( $translator, $data ) = @_;
103 my $schema = $translator->schema;
104 local $DEBUG = $translator->debug;
105 my $xp = XML::XPath->new(xml => $data);
107 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
110 # Work our way through the tables
112 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
115 "".$xp->findvalue('sqlf:order',$a)
117 "".$xp->findvalue('sqlf:order',$b)
120 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
122 my $table = $schema->add_table(
123 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
124 ) or die $schema->error;
129 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
132 ("".$xp->findvalue('sqlf:order',$a) || 0)
134 ("".$xp->findvalue('sqlf:order',$b) || 0)
137 my %fdata = get_tagfields($xp, $_, "sqlf:",
138 qw/name data_type size default_value is_nullable
139 is_auto_increment is_primary_key is_foreign_key comments/
143 exists $fdata{'default_value'} and
144 defined $fdata{'default_value'}
146 if ( $fdata{'default_value'} =~ /^\s*NULL\s*$/ ) {
147 $fdata{'default_value'}= undef;
149 elsif ( $fdata{'default_value'} =~ /^\s*EMPTY_STRING\s*$/ ) {
150 $fdata{'default_value'} = "";
154 my $field = $table->add_field( %fdata ) or die $table->error;
156 $table->primary_key( $field->name ) if $fdata{'is_primary_key'};
160 # - We should be able to make the table obj spot this when
162 # - Deal with $field->extra
169 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
171 my %data = get_tagfields($xp, $_, "sqlf:",
172 qw/name type table fields reference_fields reference_table
173 match_type on_delete_do on_update_do/
175 $table->add_constraint( %data ) or die $table->error;
181 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
183 my %data = get_tagfields($xp, $_, "sqlf:",
184 qw/name type fields options/);
185 $table->add_index( %data ) or die $table->error;
193 @nodes = $xp->findnodes('/sqlf:schema/sqlf:view');
195 my %data = get_tagfields($xp, $_, "sqlf:",
196 qw/name sql fields order/
198 $schema->add_view( %data ) or die $schema->error;
204 @nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger');
206 my %data = get_tagfields($xp, $_, "sqlf:",
207 qw/name perform_action_when database_event fields on_table action order/
209 $schema->add_trigger( %data ) or die $schema->error;
215 @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure');
217 my %data = get_tagfields($xp, $_, "sqlf:",
218 qw/name sql parameters owner comments order/
220 $schema->add_procedure( %data ) or die $schema->error;
226 # -------------------------------------------------------------------
229 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
230 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
232 # Returns hash of data. If a tag isn't in the file it is not in this
234 # TODO Add handling of and explicit NULL value.
237 my ($xp, $node, @names) = @_;
240 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
241 my $thisns = (s/(^.*?:)// ? $1 : $ns);
243 foreach my $path ( "\@$thisns$_", "$thisns$_" ) {
244 $data{ $_ } = "".$xp->findvalue( $path, $node )
245 if $xp->exists( $path, $node );
247 debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
251 return wantarray ? %data : \%data;
256 # -------------------------------------------------------------------
262 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and
263 hence also false. This is a bit counter intuative for some tags as
264 seeing <sqlf:is_nullable /> you might think that it was set when it
265 fact it wouldn't be. So for now it is safest not to use them until
266 their handling by the parser is defined.
278 Test forign keys are parsed ok.
282 Sort out sane handling of empty tags <foo/> vs tags with no content
283 <foo></foo> vs it no tag being there.
287 Control over defaulting of non-existant tags.
293 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
297 perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
298 SQL::Translator::Schema.