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