1 package SQL::Translator::Parser::SqlfXML;
3 # -------------------------------------------------------------------
4 # $Id: SqlfXML.pm,v 1.1 2003-08-06 17:14: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 and example of the XML translate one of your schema :) e.g.
50 $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql
57 use vars qw[ $DEBUG $VERSION @EXPORT_OK ];
58 $VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/;
59 $DEBUG = 0 unless defined $DEBUG;
63 use base qw(Exporter);
64 @EXPORT_OK = qw(parse);
66 use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo!
68 use XML::XPath::XMLParser;
71 warn @_,"\n" if $DEBUG;
75 my ( $translator, $data ) = @_;
76 my $schema = $translator->schema;
77 local $DEBUG = $translator->debug;
78 #local $TRACE = $translator->trace ? 1 : undef;
79 # Nothing with trace option yet!
81 my $xp = XML::XPath->new(xml => $data);
82 $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml");
84 # Work our way through the tables
86 my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table');
88 sort { "".$xp->findvalue('sqlf:order',$a)
89 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
91 debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode);
92 my $table = $schema->add_table(
93 get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/)
94 ) or die $schema->error;
98 my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode);
100 sort { "".$xp->findvalue('sqlf:order',$a)
101 <=> "".$xp->findvalue('sqlf:order',$b) } @nodes
103 my %fdata = get_tagfields($xp, $_, "sqlf:",
104 qw/name data_type size default_value is_nullable is_auto_increment
105 is_primary_key is_foreign_key comments/);
106 my $field = $table->add_field(%fdata) or die $schema->error;
107 $table->primary_key($field->name) if $fdata{'is_primary_key'};
108 # TODO We should be able to make the table obj spot this when we
110 # TODO Deal with $field->extra
115 @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode);
117 my %data = get_tagfields($xp, $_, "sqlf:",
118 qw/name type table fields reference_fields reference_table
119 match_type on_delete_do on_update_do/);
120 $table->add_constraint(%data) or die $schema->error;
125 @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode);
127 my %data = get_tagfields($xp, $_, "sqlf:",
128 qw/name type fields options/);
129 $table->add_index(%data) or die $schema->error;
137 # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/;
138 # get_tagfields $node, "sqlf:" => qw/name type fields reference/;
140 my ($xp, $node, @names) = @_;
143 if ( m/:$/ ) { $ns = $_; next; } # Set def namespace
144 $data{$_} = "".$xp->findvalue( (s/(^.*?:)// ? $1 : $ns).$_, $node );
146 return wantarray ? %data : \%data;
157 * Support sqf:options.
158 * Test forign keys are parsed ok.
159 * Control over defaulting and parsing of empty vs non-existant tags.
163 Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>,
167 perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML,
168 SQL::Translator::Schema.