Commit | Line | Data |
0a689100 |
1 | package SQL::Translator::Producer::XML::SQLFairy; |
2 | |
3 | # ------------------------------------------------------------------- |
f997b9ab |
4 | # Copyright (C) 2003-9 SQLFair Authors. |
0a689100 |
5 | # |
6 | # This program is free software; you can redistribute it and/or |
7 | # modify it under the terms of the GNU General Public License as |
8 | # published by the Free Software Foundation; version 2. |
9 | # |
10 | # This program is distributed in the hope that it will be useful, but |
11 | # WITHOUT ANY WARRANTY; without even the implied warranty of |
12 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU |
13 | # General Public License for more details. |
14 | # |
15 | # You should have received a copy of the GNU General Public License |
16 | # along with this program; if not, write to the Free Software |
17 | # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA |
18 | # 02111-1307 USA |
19 | # ------------------------------------------------------------------- |
20 | |
21 | =pod |
22 | |
23 | =head1 NAME |
24 | |
a7d50b44 |
25 | SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format |
0a689100 |
26 | |
27 | =head1 SYNOPSIS |
28 | |
29 | use SQL::Translator; |
30 | |
31 | my $t = SQL::Translator->new( |
32 | from => 'MySQL', |
a7d50b44 |
33 | to => 'XML-SQLFairy', |
0a689100 |
34 | filename => 'schema.sql', |
35 | show_warnings => 1, |
0a689100 |
36 | ); |
37 | |
38 | print $t->translate; |
39 | |
b89a67a0 |
40 | =head1 DESCRIPTION |
0a689100 |
41 | |
91f28468 |
42 | Creates XML output of a schema, in the flavor of XML used natively by the |
43 | SQLFairy project (L<SQL::Translator>). This format is detailed here. |
0a689100 |
44 | |
91f28468 |
45 | The XML lives in the C<http://sqlfairy.sourceforge.net/sqlfairy.xml> namespace. |
b89a67a0 |
46 | With a root element of <schema>. |
0a689100 |
47 | |
91f28468 |
48 | Objects in the schema are mapped to tags of the same name as the objects class |
49 | (all lowercase). |
0a689100 |
50 | |
b89a67a0 |
51 | The attributes of the objects (e.g. $field->name) are mapped to attributes of |
52 | the tag, except for sql, comments and action, which get mapped to child data |
53 | elements. |
0a689100 |
54 | |
b89a67a0 |
55 | List valued attributes (such as the list of fields in an index) |
91f28468 |
56 | get mapped to comma seperated lists of values in the attribute. |
0a689100 |
57 | |
b89a67a0 |
58 | Child objects, such as a tables fields, get mapped to child tags wrapped in a |
59 | set of container tags using the plural of their contained classes name. |
0a689100 |
60 | |
0eebe059 |
61 | An objects's extra attribute (a hash of arbitary data) is |
e0a0c3e1 |
62 | mapped to a tag called extra, with the hash of data as attributes, sorted into |
63 | alphabetical order. |
64 | |
b89a67a0 |
65 | e.g. |
0a689100 |
66 | |
b89a67a0 |
67 | <schema name="" database="" |
68 | xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml"> |
0a689100 |
69 | |
91f28468 |
70 | <tables> |
71 | <table name="Story" order="1"> |
72 | <fields> |
73 | <field name="id" data_type="BIGINT" size="20" |
74 | is_nullable="0" is_auto_increment="1" is_primary_key="1" |
75 | is_foreign_key="0" order="3"> |
76 | <extra ZEROFILL="1" /> |
77 | <comments></comments> |
78 | </field> |
79 | <field name="created" data_type="datetime" size="0" |
80 | is_nullable="1" is_auto_increment="0" is_primary_key="0" |
81 | is_foreign_key="0" order="1"> |
82 | <extra /> |
83 | <comments></comments> |
84 | </field> |
85 | ... |
86 | </fields> |
87 | <indices> |
88 | <index name="foobar" type="NORMAL" fields="foo,bar" options="" /> |
89 | </indices> |
90 | </table> |
91 | </tables> |
92 | |
93 | <views> |
94 | <view name="email_list" fields="email" order="1"> |
95 | <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql> |
96 | </view> |
97 | </views> |
b89a67a0 |
98 | |
99 | </schema> |
100 | |
101 | To see a complete example of the XML translate one of your schema :) |
102 | |
103 | $ sqlt -f MySQL -t XML-SQLFairy schema.sql |
104 | |
105 | =head1 ARGS |
0a689100 |
106 | |
983ed646 |
107 | =over 4 |
108 | |
109 | =item add_prefix |
110 | |
111 | Set to true to use the default namespace prefix of 'sqlf', instead of using |
112 | the default namespace for |
113 | C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace> |
114 | |
115 | e.g. |
116 | |
117 | <!-- add_prefix=0 --> |
118 | <field name="foo" /> |
119 | |
120 | <!-- add_prefix=1 --> |
121 | <sqlf:field name="foo" /> |
122 | |
123 | =item prefix |
124 | |
125 | Set to the namespace prefix you want to use for the |
126 | C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace> |
127 | |
128 | e.g. |
129 | |
130 | <!-- prefix='foo' --> |
131 | <foo:field name="foo" /> |
132 | |
e0a0c3e1 |
133 | =item newlines |
134 | |
135 | If true (the default) inserts newlines around the XML, otherwise the schema is |
136 | written on one line. |
137 | |
138 | =item indent |
139 | |
140 | When using newlines the number of whitespace characters to use as the indent. |
141 | Default is 2, set to 0 to turn off indenting. |
142 | |
983ed646 |
143 | =back |
0a689100 |
144 | |
4a268a6c |
145 | =head1 LEGACY FORMAT |
146 | |
147 | The previous version of the SQLFairy XML allowed the attributes of the the |
148 | schema objects to be written as either xml attributes or as data elements, in |
149 | any combination. The old producer could produce attribute only or data element |
150 | only versions. While this allowed for lots of flexibility in writing the XML |
151 | the result is a great many possible XML formats, not so good for DTD writing, |
152 | XPathing etc! So we have moved to a fixed version described above. |
153 | |
154 | This version of the producer will now only produce the new style XML. |
91f28468 |
155 | To convert your old format files simply pass them through the translator :) |
4a268a6c |
156 | |
91f28468 |
157 | $ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml |
4a268a6c |
158 | |
0a689100 |
159 | =cut |
160 | |
161 | use strict; |
da06ac74 |
162 | use vars qw[ $VERSION @EXPORT_OK ]; |
11ad2df9 |
163 | $VERSION = '1.59'; |
0a689100 |
164 | |
165 | use Exporter; |
166 | use base qw(Exporter); |
167 | @EXPORT_OK = qw(produce); |
168 | |
169 | use IO::Scalar; |
170 | use SQL::Translator::Utils qw(header_comment debug); |
f135f8f9 |
171 | BEGIN { |
172 | # Will someone fix XML::Writer already? |
173 | local $^W = 0; |
174 | require XML::Writer; |
175 | import XML::Writer; |
176 | } |
0a689100 |
177 | |
23735f6a |
178 | # Which schema object attributes (methods) to write as xml elements rather than |
179 | # as attributes. e.g. <comments>blah, blah...</comments> |
180 | my @MAP_AS_ELEMENTS = qw/sql comments action extra/; |
181 | |
182 | |
183 | |
0a689100 |
184 | my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml'; |
b89a67a0 |
185 | my $Name = 'sqlf'; |
375f0be1 |
186 | my $PArgs = {}; |
f8622fbb |
187 | my $no_comments; |
0a689100 |
188 | |
189 | sub produce { |
190 | my $translator = shift; |
191 | my $schema = $translator->schema; |
f8622fbb |
192 | $no_comments = $translator->no_comments; |
0a689100 |
193 | $PArgs = $translator->producer_args; |
983ed646 |
194 | my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1; |
195 | my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2; |
0a689100 |
196 | my $io = IO::Scalar->new; |
983ed646 |
197 | |
23735f6a |
198 | # Setup the XML::Writer and set the namespace |
983ed646 |
199 | my $prefix = ""; |
200 | $prefix = $Name if $PArgs->{add_prefix}; |
201 | $prefix = $PArgs->{prefix} if $PArgs->{prefix}; |
0a689100 |
202 | my $xml = XML::Writer->new( |
203 | OUTPUT => $io, |
204 | NAMESPACES => 1, |
983ed646 |
205 | PREFIX_MAP => { $Namespace => $prefix }, |
206 | DATA_MODE => $newlines, |
207 | DATA_INDENT => $indent, |
0a689100 |
208 | ); |
209 | |
23735f6a |
210 | # Start the document |
0a689100 |
211 | $xml->xmlDecl('UTF-8'); |
f8622fbb |
212 | |
213 | $xml->comment(header_comment('', '')) |
214 | unless $no_comments; |
215 | |
1caf2bb2 |
216 | xml_obj($xml, $schema, |
0eebe059 |
217 | tag => "schema", methods => [qw/name database extra/], end_tag => 0 ); |
0a689100 |
218 | |
219 | # |
220 | # Table |
221 | # |
87c5565e |
222 | $xml->startTag( [ $Namespace => "tables" ] ); |
0a689100 |
223 | for my $table ( $schema->get_tables ) { |
224 | debug "Table:",$table->name; |
d3422086 |
225 | xml_obj($xml, $table, |
87c5565e |
226 | tag => "table", |
0eebe059 |
227 | methods => [qw/name order extra/], |
87c5565e |
228 | end_tag => 0 |
229 | ); |
0a689100 |
230 | |
231 | # |
232 | # Fields |
233 | # |
87c5565e |
234 | xml_obj_children( $xml, $table, |
235 | tag => 'field', |
236 | methods =>[qw/ |
237 | name data_type size is_nullable default_value is_auto_increment |
238 | is_primary_key is_foreign_key extra comments order |
239 | /], |
240 | ); |
0a689100 |
241 | |
242 | # |
243 | # Indices |
244 | # |
87c5565e |
245 | xml_obj_children( $xml, $table, |
246 | tag => 'index', |
247 | collection_tag => "indices", |
0eebe059 |
248 | methods => [qw/name type fields options extra/], |
87c5565e |
249 | ); |
0a689100 |
250 | |
251 | # |
252 | # Constraints |
253 | # |
87c5565e |
254 | xml_obj_children( $xml, $table, |
255 | tag => 'constraint', |
256 | methods => [qw/ |
257 | name type fields reference_table reference_fields |
258 | on_delete on_update match_type expression options deferrable |
0eebe059 |
259 | extra |
87c5565e |
260 | /], |
261 | ); |
0a689100 |
262 | |
7c71eaab |
263 | # |
264 | # Comments |
265 | # |
266 | xml_obj_children( $xml, $table, |
267 | tag => 'comment', |
268 | collection_tag => "comments", |
269 | methods => [qw/ |
270 | comments |
271 | /], |
272 | ); |
273 | |
0a689100 |
274 | $xml->endTag( [ $Namespace => 'table' ] ); |
275 | } |
87c5565e |
276 | $xml->endTag( [ $Namespace => 'tables' ] ); |
d3422086 |
277 | |
1e3867bf |
278 | # |
279 | # Views |
280 | # |
87c5565e |
281 | xml_obj_children( $xml, $schema, |
282 | tag => 'view', |
0eebe059 |
283 | methods => [qw/name sql fields order extra/], |
87c5565e |
284 | ); |
d3422086 |
285 | |
1e3867bf |
286 | # |
287 | # Tiggers |
288 | # |
87c5565e |
289 | xml_obj_children( $xml, $schema, |
290 | tag => 'trigger', |
222094af |
291 | methods => [qw/name database_events action on_table perform_action_when |
0eebe059 |
292 | fields order extra/], |
87c5565e |
293 | ); |
0a689100 |
294 | |
1e3867bf |
295 | # |
296 | # Procedures |
297 | # |
87c5565e |
298 | xml_obj_children( $xml, $schema, |
299 | tag => 'procedure', |
0eebe059 |
300 | methods => [qw/name sql parameters owner comments order extra/], |
87c5565e |
301 | ); |
d3422086 |
302 | |
0a689100 |
303 | $xml->endTag([ $Namespace => 'schema' ]); |
304 | $xml->end; |
305 | |
306 | return $io; |
307 | } |
308 | |
87c5565e |
309 | |
310 | # |
311 | # Takes and XML::Write object, Schema::* parent object, the tag name, |
312 | # the collection name and a list of methods (of the children) to write as XML. |
313 | # The collection name defaults to the name with an s on the end and is used to |
314 | # work out the method to get the children with. eg a name of 'foo' gives a |
315 | # collection of foos and gets the members using ->get_foos. |
316 | # |
317 | sub xml_obj_children { |
318 | my ($xml,$parent) = (shift,shift); |
319 | my %args = @_; |
320 | my ($name,$collection_name,$methods) |
321 | = @args{qw/tag collection_tag methods/}; |
322 | $collection_name ||= "${name}s"; |
7c71eaab |
323 | |
324 | my $meth; |
325 | if ( $collection_name eq 'comments' ) { |
326 | $meth = 'comments'; |
327 | } else { |
328 | $meth = "get_$collection_name"; |
329 | } |
87c5565e |
330 | |
331 | my @kids = $parent->$meth; |
332 | #@kids || return; |
333 | $xml->startTag( [ $Namespace => $collection_name ] ); |
7c71eaab |
334 | |
87c5565e |
335 | for my $obj ( @kids ) { |
7c71eaab |
336 | if ( $collection_name eq 'comments' ){ |
337 | $xml->dataElement( [ $Namespace => 'comment' ], $obj ); |
338 | } else { |
339 | xml_obj($xml, $obj, |
340 | tag => "$name", |
341 | end_tag => 1, |
342 | methods => $methods, |
343 | ); |
344 | } |
87c5565e |
345 | } |
346 | $xml->endTag( [ $Namespace => $collection_name ] ); |
347 | } |
348 | |
1caf2bb2 |
349 | # |
23735f6a |
350 | # Takes an XML::Writer, Schema::* object and list of method names |
b89a67a0 |
351 | # and writes the obect out as XML. All methods values are written as attributes |
87c5565e |
352 | # except for the methods listed in @MAP_AS_ELEMENTS which get written as child |
353 | # data elements. |
b89a67a0 |
354 | # |
23735f6a |
355 | # The attributes/tags are written in the same order as the method names are |
b89a67a0 |
356 | # passed. |
357 | # |
358 | # TODO |
1caf2bb2 |
359 | # - Should the Namespace be passed in instead of global? Pass in the same |
360 | # as Writer ie [ NS => TAGNAME ] |
361 | # |
23735f6a |
362 | my $elements_re = join("|", @MAP_AS_ELEMENTS); |
363 | $elements_re = qr/^($elements_re)$/; |
0a689100 |
364 | sub xml_obj { |
d3422086 |
365 | my ($xml, $obj, %args) = @_; |
366 | my $tag = $args{'tag'} || ''; |
367 | my $end_tag = $args{'end_tag'} || ''; |
d3422086 |
368 | my @meths = @{ $args{'methods'} }; |
369 | my $empty_tag = 0; |
370 | |
b89a67a0 |
371 | # Use array to ensure consistant (ie not hash) ordering of attribs |
372 | # The order comes from the meths list passed in. |
373 | my @tags; |
374 | my @attr; |
375 | foreach ( grep { defined $obj->$_ } @meths ) { |
23735f6a |
376 | my $what = m/$elements_re/ ? \@tags : \@attr; |
e0a0c3e1 |
377 | my $val = $_ eq 'extra' |
378 | ? { $obj->$_ } |
379 | : $obj->$_; |
0a689100 |
380 | $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; |
b89a67a0 |
381 | push @$what, $_ => $val; |
382 | }; |
383 | my $child_tags = @tags; |
384 | $end_tag && !$child_tags |
385 | ? $xml->emptyTag( [ $Namespace => $tag ], @attr ) |
386 | : $xml->startTag( [ $Namespace => $tag ], @attr ); |
387 | while ( my ($name,$val) = splice @tags,0,2 ) { |
e0a0c3e1 |
388 | if ( ref $val eq 'HASH' ) { |
389 | $xml->emptyTag( [ $Namespace => $name ], |
390 | map { ($_, $val->{$_}) } sort keys %$val ); |
391 | } |
392 | else { |
393 | $xml->dataElement( [ $Namespace => $name ], $val ); |
394 | } |
0a689100 |
395 | } |
b89a67a0 |
396 | $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag; |
0a689100 |
397 | } |
398 | |
399 | 1; |
400 | |
401 | # ------------------------------------------------------------------- |
402 | # The eyes of fire, the nostrils of air, |
403 | # The mouth of water, the beard of earth. |
404 | # William Blake |
405 | # ------------------------------------------------------------------- |
406 | |
407 | =pod |
408 | |
409 | =head1 AUTHORS |
410 | |
f997b9ab |
411 | Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>, |
d3422086 |
412 | Darren Chamberlain E<lt>darren@cpan.orgE<gt>, |
0a689100 |
413 | Mark Addison E<lt>mark.addison@itn.co.ukE<gt>. |
414 | |
415 | =head1 SEE ALSO |
416 | |
91f28468 |
417 | L<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>, |
418 | L<SQL::Translator::Schema>, L<XML::Writer>. |
0a689100 |
419 | |
420 | =cut |