Commit | Line | Data |
c957e92d |
1 | package SQL::Translator::Parser::SqlfXML; |
2 | |
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>, |
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 | |
52 | =cut |
53 | |
54 | use strict; |
55 | use warnings; |
56 | |
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; |
60 | |
61 | use Data::Dumper; |
62 | use Exporter; |
63 | use base qw(Exporter); |
64 | @EXPORT_OK = qw(parse); |
65 | |
66 | use base qw/SQL::Translator::Parser/; # Doesnt do anything at the mo! |
67 | use XML::XPath; |
68 | use XML::XPath::XMLParser; |
69 | |
70 | sub debug { |
71 | warn @_,"\n" if $DEBUG; |
72 | } |
73 | |
74 | sub parse { |
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! |
80 | |
81 | my $xp = XML::XPath->new(xml => $data); |
82 | $xp->set_namespace("sqlf", "http://sqlfairy.sourceforge.net/sqlfairy.xml"); |
83 | |
84 | # Work our way through the tables |
85 | # |
86 | my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table'); |
87 | for my $tblnode ( |
88 | sort { "".$xp->findvalue('sqlf:order',$a) |
89 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
90 | ) { |
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; |
95 | |
96 | # Fields |
97 | # |
98 | my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode); |
99 | foreach ( |
100 | sort { "".$xp->findvalue('sqlf:order',$a) |
101 | <=> "".$xp->findvalue('sqlf:order',$b) } @nodes |
102 | ) { |
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 |
109 | # use add_field. |
110 | # TODO Deal with $field->extra |
111 | } |
112 | |
113 | # Constraints |
114 | # |
115 | @nodes = $xp->findnodes('sqlf:constraints/sqlf:constraint',$tblnode); |
116 | foreach (@nodes) { |
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; |
121 | } |
122 | |
123 | # Indexes |
124 | # |
125 | @nodes = $xp->findnodes('sqlf:indices/sqlf:index',$tblnode); |
126 | foreach (@nodes) { |
127 | my %data = get_tagfields($xp, $_, "sqlf:", |
128 | qw/name type fields options/); |
129 | $table->add_index(%data) or die $schema->error; |
130 | } |
131 | |
132 | } # tables loop |
133 | |
134 | return 1; |
135 | } |
136 | |
137 | # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/; |
138 | # get_tagfields $node, "sqlf:" => qw/name type fields reference/; |
139 | sub get_tagfields { |
140 | my ($xp, $node, @names) = @_; |
141 | my (%data, $ns); |
142 | foreach (@names) { |
143 | if ( m/:$/ ) { $ns = $_; next; } # Set def namespace |
144 | $data{$_} = "".$xp->findvalue( (s/(^.*?:)// ? $1 : $ns).$_, $node ); |
145 | } |
146 | return wantarray ? %data : \%data; |
147 | } |
148 | |
149 | 1; |
150 | |
151 | __END__ |
152 | |
153 | =pod |
154 | |
155 | =head1 TODO |
156 | |
157 | * Support sqf:options. |
158 | * Test forign keys are parsed ok. |
159 | * Control over defaulting and parsing of empty vs non-existant tags. |
160 | |
161 | =head1 AUTHOR |
162 | |
163 | Mark D. Addison E<lt>mark.addison@itn.co.ukE<gt>, |
164 | |
165 | =head1 SEE ALSO |
166 | |
167 | perl(1), SQL::Translator, SQL::Translator::Producer::SqlfXML, |
168 | SQL::Translator::Schema. |
169 | |
170 | =cut |