1 package SQL::Translator::Parser::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.3 2003-08-26 21:41:21 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 $ 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.3 $ =~ /(\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 $schema->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 $schema->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 $schema->error;
193 # -------------------------------------------------------------------
196 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
197 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
199 # Returns hash of data. If a tag isn't in the file it is not in this
201 # TODO Add handling of and explicit NULL value.
204 my ($xp, $node, @names) = @_;
207 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
208 my $thisns = (s/(^.*?:)// ? $1 : $ns);
210 foreach my $path ( "\@$thisns$_", "$thisns$_" ) {
211 $data{ $_ } = $xp->findvalue( $path, $node )
212 if $xp->exists( $path, $node );
214 debug "Got $_=".( defined $data{ $_ } ? $data{ $_ } : 'UNDEF' );
218 return wantarray ? %data : \%data;
223 # -------------------------------------------------------------------
229 B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and
230 hence also false. This is a bit counter intuative for some tags as
231 seeing <sqlf:is_nullable /> you might think that it was set when it
232 fact it wouldn't be. So for now it is safest not to use them until
233 their handling by the parser is defined.
245 Test forign keys are parsed ok.
249 Sort out sane handling of empty tags <foo/> vs tags with no content
250 <foo></foo> vs it no tag being there.
254 Control over defaulting of non-existant tags.
260 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>.
264 perl(1), SQL::Translator, SQL::Translator::Producer::XML::SQLFairy,
265 SQL::Translator::Schema.