Commit | Line | Data |
c957e92d |
1 | package SQL::Translator::Parser::SqlfXML; |
2 | |
3 | # ------------------------------------------------------------------- |
5ff70f1a |
4 | # $Id: SqlfXML.pm,v 1.2 2003-08-06 22:08:16 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 | |
c957e92d |
62 | =cut |
63 | |
64 | use strict; |
65 | use warnings; |
66 | |
67 | use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; |
5ff70f1a |
68 | $VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; |
c957e92d |
69 | $DEBUG = 0 unless defined $DEBUG; |
70 | |
71 | use Data::Dumper; |
72 | use Exporter; |
73 | use base qw(Exporter); |
74 | @EXPORT_OK = qw(parse); |
75 | |
76 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
77 | use XML::XPath; |
78 | use XML::XPath::XMLParser; |
79 | |
80 | sub debug { |
81 | warn @_,"\n" if $DEBUG; |
82 | } |
83 | |
84 | sub parse { |
85 | my ( $translator, $data ) = @_; |
86 | my $schema = $translator->schema; |
87 | local $DEBUG = $translator->debug; |
88 | #local $TRACE = $translator->trace ? 1 : undef; |
89 | # Nothing with trace option yet! |
90 | |
91 | my $xp = XML::XPath->new(xml => $data); |
92 | $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml"); |
93 | |
94 | # Work our way through the tables |
95 | # |
96 | my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table'); |
97 | for my $tblnode ( |
98 | sort { "".$xp->findvalue('sqlf:order',$a) |
99 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
100 | ) { |
101 | debug "Adding table:".$xp->findvalue('sqlf:name',$tblnode); |
102 | my $table = $schema->add_table( |
103 | get_tagfields($xp, $tblnode, "sqlf:" => qw/name order/) |
104 | ) or die $schema->error; |
105 | |
106 | # Fields |
107 | # |
108 | my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode); |
109 | foreach ( |
110 | sort { "".$xp->findvalue('sqlf:order',$a) |
111 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
112 | ) { |
113 | my %fdata = get_tagfields($xp, $_, "sqlf:", |
114 | qw/name data_type size default_value is_nullable is_auto_increment |
115 | is_primary_key is_foreign_key comments/); |
5ff70f1a |
116 | if (exists $fdata{default_value} and defined $fdata{default_value}){ |
117 | if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) { |
118 | $fdata{default_value}= undef; |
119 | } |
120 | elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) { |
121 | $fdata{default_value} = ""; |
122 | } |
123 | } |
c957e92d |
124 | my $field = $table->add_field(%fdata) or die $schema->error; |
125 | $table->primary_key($field->name) if $fdata{'is_primary_key'}; |
126 | # TODO We should be able to make the table obj spot this when we |
127 | # use add_field. |
128 | # TODO Deal with $field->extra |
129 | } |
130 | |
131 | # Constraints |
132 | # |
133 | @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode); |
134 | foreach (@nodes) { |
135 | my %data = get_tagfields($xp, $_, "sqlf:", |
136 | qw/name type table fields reference_fields reference_table |
137 | match_type on_delete_do on_update_do/); |
138 | $table->add_constraint(%data) or die $schema->error; |
139 | } |
140 | |
141 | # Indexes |
142 | # |
143 | @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode); |
144 | foreach (@nodes) { |
145 | my %data = get_tagfields($xp, $_, "sqlf:", |
146 | qw/name type fields options/); |
147 | $table->add_index(%data) or die $schema->error; |
148 | } |
149 | |
150 | } # tables loop |
151 | |
152 | return 1; |
153 | } |
154 | |
155 | # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/; |
156 | # get_tagfields $node, "sqlf:" => qw/name type fields reference/; |
5ff70f1a |
157 | # |
158 | # Returns hash of data. If a tag isn't in the file it is not in this |
159 | # hash. |
160 | # TODO Add handling of and explicit NULL value. |
c957e92d |
161 | sub get_tagfields { |
162 | my ($xp, $node, @names) = @_; |
163 | my (%data, $ns); |
164 | foreach (@names) { |
165 | if ( m/:$/ ) { $ns = $_; next; } # Set def namespace |
5ff70f1a |
166 | my $path = (s/(^.*?:)// ? $1 : $ns).$_; |
167 | $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node); |
168 | debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF"); |
c957e92d |
169 | } |
170 | return wantarray ? %data : \%data; |
171 | } |
172 | |
173 | 1; |
174 | |
175 | __END__ |
176 | |
177 | =pod |
178 | |
179 | =head1 TODO |
180 | |
181 | * Support sqf:options. |
182 | * Test forign keys are parsed ok. |
5ff70f1a |
183 | * Control over defaulting of non-existant tags. |
c957e92d |
184 | |
185 | =head1 AUTHOR |
186 | |
187 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>, |
188 | |
189 | =head1 SEE ALSO |
190 | |
191 | perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML, |
192 | SQL::Translator::Schema. |
193 | |
194 | =cut |