1 package SQL::Translator::Producer::XML::SQLFairy;
7 SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format
13 my $t = SQL::Translator->new(
16 filename => 'schema.sql',
24 Creates XML output of a schema, in the flavor of XML used natively by the
25 SQLFairy project (L<SQL::Translator>). This format is detailed here.
27 The XML lives in the C<http://sqlfairy.sourceforge.net/sqlfairy.xml> namespace.
28 With a root element of <schema>.
30 Objects in the schema are mapped to tags of the same name as the objects class
33 The attributes of the objects (e.g. $field->name) are mapped to attributes of
34 the tag, except for sql, comments and action, which get mapped to child data
37 List valued attributes (such as the list of fields in an index)
38 get mapped to comma separated lists of values in the attribute.
40 Child objects, such as a tables fields, get mapped to child tags wrapped in a
41 set of container tags using the plural of their contained classes name.
43 An objects' extra attribute (a hash of arbitrary data) is
44 mapped to a tag called extra, with the hash of data as attributes, sorted into
49 <schema name="" database=""
50 xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
53 <table name="Story" order="1">
55 <field name="id" data_type="BIGINT" size="20"
56 is_nullable="0" is_auto_increment="1" is_primary_key="1"
57 is_foreign_key="0" order="3">
58 <extra ZEROFILL="1" />
61 <field name="created" data_type="datetime" size="0"
62 is_nullable="1" is_auto_increment="0" is_primary_key="0"
63 is_foreign_key="0" order="1">
70 <index name="foobar" type="NORMAL" fields="foo,bar" options="" />
76 <view name="email_list" fields="email" order="1">
77 <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
83 To see a complete example of the XML translate one of your schema :)
85 $ sqlt -f MySQL -t XML-SQLFairy schema.sql
93 Set to true to use the default namespace prefix of 'sqlf', instead of using
94 the default namespace for
95 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
102 <!-- add_prefix=1 -->
103 <sqlf:field name="foo" />
107 Set to the namespace prefix you want to use for the
108 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
112 <!-- prefix='foo' -->
113 <foo:field name="foo" />
117 If true (the default) inserts newlines around the XML, otherwise the schema is
122 When using newlines the number of whitespace characters to use as the indent.
123 Default is 2, set to 0 to turn off indenting.
129 The previous version of the SQLFairy XML allowed the attributes of the the
130 schema objects to be written as either xml attributes or as data elements, in
131 any combination. The old producer could produce attribute only or data element
132 only versions. While this allowed for lots of flexibility in writing the XML
133 the result is a great many possible XML formats, not so good for DTD writing,
134 XPathing etc! So we have moved to a fixed version described above.
136 This version of the producer will now only produce the new style XML.
137 To convert your old format files simply pass them through the translator :)
139 $ sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
146 our $VERSION = '1.59';
149 use base qw(Exporter);
150 @EXPORT_OK = qw(produce);
153 use SQL::Translator::Utils qw(header_comment debug);
155 # Will someone fix XML::Writer already?
161 # Which schema object attributes (methods) to write as xml elements rather than
162 # as attributes. e.g. <comments>blah, blah...</comments>
163 my @MAP_AS_ELEMENTS = qw/sql comments action extra/;
167 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
173 my $translator = shift;
174 my $schema = $translator->schema;
175 $no_comments = $translator->no_comments;
176 $PArgs = $translator->producer_args;
177 my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
178 my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
179 my $io = IO::Scalar->new;
181 # Setup the XML::Writer and set the namespace
183 $prefix = $Name if $PArgs->{add_prefix};
184 $prefix = $PArgs->{prefix} if $PArgs->{prefix};
185 my $xml = XML::Writer->new(
188 PREFIX_MAP => { $Namespace => $prefix },
189 DATA_MODE => $newlines,
190 DATA_INDENT => $indent,
194 $xml->xmlDecl('UTF-8');
196 $xml->comment(header_comment('', ''))
199 xml_obj($xml, $schema,
200 tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
205 $xml->startTag( [ $Namespace => "tables" ] );
206 for my $table ( $schema->get_tables ) {
207 debug "Table:",$table->name;
208 xml_obj($xml, $table,
210 methods => [qw/name order extra/],
217 xml_obj_children( $xml, $table,
220 name data_type size is_nullable default_value is_auto_increment
221 is_primary_key is_foreign_key extra comments order
228 xml_obj_children( $xml, $table,
230 collection_tag => "indices",
231 methods => [qw/name type fields options extra/],
237 xml_obj_children( $xml, $table,
240 name type fields reference_table reference_fields
241 on_delete on_update match_type expression options deferrable
249 xml_obj_children( $xml, $table,
251 collection_tag => "comments",
257 $xml->endTag( [ $Namespace => 'table' ] );
259 $xml->endTag( [ $Namespace => 'tables' ] );
264 xml_obj_children( $xml, $schema,
266 methods => [qw/name sql fields order extra/],
272 xml_obj_children( $xml, $schema,
274 methods => [qw/name database_events action on_table perform_action_when
275 fields order extra/],
281 xml_obj_children( $xml, $schema,
283 methods => [qw/name sql parameters owner comments order extra/],
286 $xml->endTag([ $Namespace => 'schema' ]);
294 # Takes and XML::Write object, Schema::* parent object, the tag name,
295 # the collection name and a list of methods (of the children) to write as XML.
296 # The collection name defaults to the name with an s on the end and is used to
297 # work out the method to get the children with. eg a name of 'foo' gives a
298 # collection of foos and gets the members using ->get_foos.
300 sub xml_obj_children {
301 my ($xml,$parent) = (shift,shift);
303 my ($name,$collection_name,$methods)
304 = @args{qw/tag collection_tag methods/};
305 $collection_name ||= "${name}s";
308 if ( $collection_name eq 'comments' ) {
311 $meth = "get_$collection_name";
314 my @kids = $parent->$meth;
316 $xml->startTag( [ $Namespace => $collection_name ] );
318 for my $obj ( @kids ) {
319 if ( $collection_name eq 'comments' ){
320 $xml->dataElement( [ $Namespace => 'comment' ], $obj );
329 $xml->endTag( [ $Namespace => $collection_name ] );
333 # Takes an XML::Writer, Schema::* object and list of method names
334 # and writes the obect out as XML. All methods values are written as attributes
335 # except for the methods listed in @MAP_AS_ELEMENTS which get written as child
338 # The attributes/tags are written in the same order as the method names are
342 # - Should the Namespace be passed in instead of global? Pass in the same
343 # as Writer ie [ NS => TAGNAME ]
345 my $elements_re = join("|", @MAP_AS_ELEMENTS);
346 $elements_re = qr/^($elements_re)$/;
348 my ($xml, $obj, %args) = @_;
349 my $tag = $args{'tag'} || '';
350 my $end_tag = $args{'end_tag'} || '';
351 my @meths = @{ $args{'methods'} };
354 # Use array to ensure consistant (ie not hash) ordering of attribs
355 # The order comes from the meths list passed in.
358 foreach ( grep { defined $obj->$_ } @meths ) {
359 my $what = m/$elements_re/ ? \@tags : \@attr;
360 my $val = $_ eq 'extra'
363 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
364 push @$what, $_ => $val;
366 my $child_tags = @tags;
367 $end_tag && !$child_tags
368 ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
369 : $xml->startTag( [ $Namespace => $tag ], @attr );
370 while ( my ($name,$val) = splice @tags,0,2 ) {
371 if ( ref $val eq 'HASH' ) {
372 $xml->emptyTag( [ $Namespace => $name ],
373 map { ($_, $val->{$_}) } sort keys %$val );
376 $xml->dataElement( [ $Namespace => $name ], $val );
379 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
384 # -------------------------------------------------------------------
385 # The eyes of fire, the nostrils of air,
386 # The mouth of water, the beard of earth.
388 # -------------------------------------------------------------------
394 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
395 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
396 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
400 L<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
401 L<SQL::Translator::Schema>, L<XML::Writer>.