1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # Copyright (C) 2003-9 SQLFair Authors.
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.
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.
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
19 # -------------------------------------------------------------------
25 SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format
31 my $t = SQL::Translator->new(
34 filename => 'schema.sql',
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.
45 The XML lives in the C<http://sqlfairy.sourceforge.net/sqlfairy.xml> namespace.
46 With a root element of <schema>.
48 Objects in the schema are mapped to tags of the same name as the objects class
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
55 List valued attributes (such as the list of fields in an index)
56 get mapped to comma seperated lists of values in the attribute.
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.
61 An objects's extra attribute (a hash of arbitary data) is
62 mapped to a tag called extra, with the hash of data as attributes, sorted into
67 <schema name="" database=""
68 xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
71 <table name="Story" order="1">
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" />
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">
88 <index name="foobar" type="NORMAL" fields="foo,bar" options="" />
94 <view name="email_list" fields="email" order="1">
95 <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
101 To see a complete example of the XML translate one of your schema :)
103 $ sqlt -f MySQL -t XML-SQLFairy schema.sql
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>
117 <!-- add_prefix=0 -->
120 <!-- add_prefix=1 -->
121 <sqlf:field name="foo" />
125 Set to the namespace prefix you want to use for the
126 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
130 <!-- prefix='foo' -->
131 <foo:field name="foo" />
135 If true (the default) inserts newlines around the XML, otherwise the schema is
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.
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.
154 This version of the producer will now only produce the new style XML.
155 To convert your old format files simply pass them through the translator :)
157 $ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
162 use vars qw[ $VERSION @EXPORT_OK ];
166 use base qw(Exporter);
167 @EXPORT_OK = qw(produce);
170 use SQL::Translator::Utils qw(header_comment debug);
172 # Will someone fix XML::Writer already?
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/;
184 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
190 my $translator = shift;
191 my $schema = $translator->schema;
192 $no_comments = $translator->no_comments;
193 $PArgs = $translator->producer_args;
194 my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
195 my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
196 my $io = IO::Scalar->new;
198 # Setup the XML::Writer and set the namespace
200 $prefix = $Name if $PArgs->{add_prefix};
201 $prefix = $PArgs->{prefix} if $PArgs->{prefix};
202 my $xml = XML::Writer->new(
205 PREFIX_MAP => { $Namespace => $prefix },
206 DATA_MODE => $newlines,
207 DATA_INDENT => $indent,
211 $xml->xmlDecl('UTF-8');
213 $xml->comment(header_comment('', ''))
216 xml_obj($xml, $schema,
217 tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
222 $xml->startTag( [ $Namespace => "tables" ] );
223 for my $table ( $schema->get_tables ) {
224 debug "Table:",$table->name;
225 xml_obj($xml, $table,
227 methods => [qw/name order extra/],
234 xml_obj_children( $xml, $table,
237 name data_type size is_nullable default_value is_auto_increment
238 is_primary_key is_foreign_key extra comments order
245 xml_obj_children( $xml, $table,
247 collection_tag => "indices",
248 methods => [qw/name type fields options extra/],
254 xml_obj_children( $xml, $table,
257 name type fields reference_table reference_fields
258 on_delete on_update match_type expression options deferrable
266 xml_obj_children( $xml, $table,
268 collection_tag => "comments",
274 $xml->endTag( [ $Namespace => 'table' ] );
276 $xml->endTag( [ $Namespace => 'tables' ] );
281 xml_obj_children( $xml, $schema,
283 methods => [qw/name sql fields order extra/],
289 xml_obj_children( $xml, $schema,
291 methods => [qw/name database_events action on_table perform_action_when
292 fields order extra/],
298 xml_obj_children( $xml, $schema,
300 methods => [qw/name sql parameters owner comments order extra/],
303 $xml->endTag([ $Namespace => 'schema' ]);
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.
317 sub xml_obj_children {
318 my ($xml,$parent) = (shift,shift);
320 my ($name,$collection_name,$methods)
321 = @args{qw/tag collection_tag methods/};
322 $collection_name ||= "${name}s";
325 if ( $collection_name eq 'comments' ) {
328 $meth = "get_$collection_name";
331 my @kids = $parent->$meth;
333 $xml->startTag( [ $Namespace => $collection_name ] );
335 for my $obj ( @kids ) {
336 if ( $collection_name eq 'comments' ){
337 $xml->dataElement( [ $Namespace => 'comment' ], $obj );
346 $xml->endTag( [ $Namespace => $collection_name ] );
350 # Takes an XML::Writer, Schema::* object and list of method names
351 # and writes the obect out as XML. All methods values are written as attributes
352 # except for the methods listed in @MAP_AS_ELEMENTS which get written as child
355 # The attributes/tags are written in the same order as the method names are
359 # - Should the Namespace be passed in instead of global? Pass in the same
360 # as Writer ie [ NS => TAGNAME ]
362 my $elements_re = join("|", @MAP_AS_ELEMENTS);
363 $elements_re = qr/^($elements_re)$/;
365 my ($xml, $obj, %args) = @_;
366 my $tag = $args{'tag'} || '';
367 my $end_tag = $args{'end_tag'} || '';
368 my @meths = @{ $args{'methods'} };
371 # Use array to ensure consistant (ie not hash) ordering of attribs
372 # The order comes from the meths list passed in.
375 foreach ( grep { defined $obj->$_ } @meths ) {
376 my $what = m/$elements_re/ ? \@tags : \@attr;
377 my $val = $_ eq 'extra'
380 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
381 push @$what, $_ => $val;
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 ) {
388 if ( ref $val eq 'HASH' ) {
389 $xml->emptyTag( [ $Namespace => $name ],
390 map { ($_, $val->{$_}) } sort keys %$val );
393 $xml->dataElement( [ $Namespace => $name ], $val );
396 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
401 # -------------------------------------------------------------------
402 # The eyes of fire, the nostrils of air,
403 # The mouth of water, the beard of earth.
405 # -------------------------------------------------------------------
411 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
412 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
413 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
417 L<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
418 L<SQL::Translator::Schema>, L<XML::Writer>.