Commit | Line | Data |
c957e92d |
1 | package SQL::Translator::Parser::SqlfXML; |
2 | |
3 | # ------------------------------------------------------------------- |
5952d39c |
4 | # $Id: SqlfXML.pm,v 1.4 2003-08-07 15:03:30 grommit Exp $ |
c957e92d |
5 | # ------------------------------------------------------------------- |
6 | # Copyright (C) 2003 Mark Addison <mark.addison@itn.co.uk>, |
7 | # |
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. |
11 | # |
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. |
16 | # |
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 |
20 | # 02111-1307 USA |
21 | # ------------------------------------------------------------------- |
22 | |
23 | =head1 NAME |
24 | |
25 | SQL::Translator::Parser::SqlfXML - parser for the XML produced by |
26 | SQL::Translator::Producer::SqlfXML. |
27 | |
28 | =head1 SYNOPSIS |
29 | |
30 | use SQL::Translator; |
31 | use SQL::Translator::Parser::SqlfXML; |
32 | |
33 | my $translator = SQL::Translator->new( |
34 | show_warnings => 1, |
35 | add_drop_table => 1, |
36 | ); |
37 | print = $obj->translate( |
38 | from => "SqlfXML", |
39 | to =>"MySQL", |
40 | filename => "fooschema.xml", |
41 | ); |
42 | |
43 | =head1 DESCRIPTION |
44 | |
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. |
47 | |
48 | To see and example of the XML translate one of your schema :) e.g. |
49 | |
50 | $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql |
51 | |
5ff70f1a |
52 | ==head1 default_value |
53 | |
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). |
57 | |
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 --> |
61 | |
5952d39c |
62 | <sqlf:default_value/> <!-- Empty string BUT DON'T USE! See BUGS --> |
b3530353 |
63 | |
c957e92d |
64 | =cut |
65 | |
66 | use strict; |
67 | use warnings; |
68 | |
69 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
5952d39c |
70 | $VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; |
c957e92d |
71 | $DEBUG = 0 unless defined $DEBUG; |
72 | |
73 | use Data::Dumper; |
74 | use Exporter; |
75 | use base qw(Exporter); |
76 | @EXPORT_OK = qw(parse); |
77 | |
78 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
79 | use XML::XPath; |
80 | use XML::XPath::XMLParser; |
81 | |
82 | sub debug { |
83 | warn @_,"\n" if $DEBUG; |
84 | } |
85 | |
86 | sub parse { |
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! |
92 | |
93 | my $xp = XML::XPath->new(xml => $data); |
94 | $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml"); |
95 | |
96 | # Work our way through the tables |
97 | # |
98 | my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table'); |
99 | for my $tblnode ( |
100 | sort { "".$xp->findvalue('sqlf:order',$a) |
101 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
102 | ) { |
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; |
107 | |
108 | # Fields |
109 | # |
110 | my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode); |
111 | foreach ( |
112 | sort { "".$xp->findvalue('sqlf:order',$a) |
113 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
114 | ) { |
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/); |
5ff70f1a |
118 | if (exists $fdata{default_value} and defined $fdata{default_value}){ |
119 | if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) { |
120 | $fdata{default_value}= undef; |
121 | } |
122 | elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) { |
123 | $fdata{default_value} = ""; |
124 | } |
125 | } |
c957e92d |
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 |
129 | # use add_field. |
130 | # TODO Deal with $field->extra |
131 | } |
132 | |
133 | # Constraints |
134 | # |
135 | @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode); |
136 | foreach (@nodes) { |
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; |
141 | } |
142 | |
143 | # Indexes |
144 | # |
145 | @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode); |
146 | foreach (@nodes) { |
147 | my %data = get_tagfields($xp, $_, "sqlf:", |
148 | qw/name type fields options/); |
149 | $table->add_index(%data) or die $schema->error; |
150 | } |
151 | |
152 | } # tables loop |
153 | |
154 | return 1; |
155 | } |
156 | |
157 | # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/; |
158 | # get_tagfields $node, "sqlf:" => qw/name type fields reference/; |
5ff70f1a |
159 | # |
160 | # Returns hash of data. If a tag isn't in the file it is not in this |
161 | # hash. |
162 | # TODO Add handling of and explicit NULL value. |
c957e92d |
163 | sub get_tagfields { |
164 | my ($xp, $node, @names) = @_; |
165 | my (%data, $ns); |
166 | foreach (@names) { |
167 | if ( m/:$/ ) { $ns = $_; next; } # Set def namespace |
5ff70f1a |
168 | my $path = (s/(^.*?:)// ? $1 : $ns).$_; |
169 | $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node); |
170 | debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF"); |
c957e92d |
171 | } |
172 | return wantarray ? %data : \%data; |
173 | } |
174 | |
175 | 1; |
176 | |
177 | __END__ |
178 | |
179 | =pod |
180 | |
b3530353 |
181 | =head1 BUGS |
182 | |
5952d39c |
183 | B<Empty Tags> e.g. <sqlf:default_value/> Will be parsed as "" and hence also |
b3530353 |
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 |
5952d39c |
187 | is defined. |
b3530353 |
188 | |
c957e92d |
189 | =head1 TODO |
190 | |
191 | * Support sqf:options. |
192 | * Test forign keys are parsed ok. |
5952d39c |
193 | * Sort out sane handling of empty tags <foo/> vs tags with no content |
194 | <foo></foo> vs it no tag being there. |
5ff70f1a |
195 | * Control over defaulting of non-existant tags. |
c957e92d |
196 | |
197 | =head1 AUTHOR |
198 | |
199 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>, |
200 | |
201 | =head1 SEE ALSO |
202 | |
203 | perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML, |
204 | SQL::Translator::Schema. |
205 | |
206 | =cut |