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
144 use vars qw[ $VERSION @EXPORT_OK ];
148 use base qw(Exporter);
149 @EXPORT_OK = qw(produce);
152 use SQL::Translator::Utils qw(header_comment debug);
154 # Will someone fix XML::Writer already?
160 # Which schema object attributes (methods) to write as xml elements rather than
161 # as attributes. e.g. <comments>blah, blah...</comments>
162 my @MAP_AS_ELEMENTS = qw/sql comments action extra/;
166 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
172 my $translator = shift;
173 my $schema = $translator->schema;
174 $no_comments = $translator->no_comments;
175 $PArgs = $translator->producer_args;
176 my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
177 my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
178 my $io = IO::Scalar->new;
180 # Setup the XML::Writer and set the namespace
182 $prefix = $Name if $PArgs->{add_prefix};
183 $prefix = $PArgs->{prefix} if $PArgs->{prefix};
184 my $xml = XML::Writer->new(
187 PREFIX_MAP => { $Namespace => $prefix },
188 DATA_MODE => $newlines,
189 DATA_INDENT => $indent,
193 $xml->xmlDecl('UTF-8');
195 $xml->comment(header_comment('', ''))
198 xml_obj($xml, $schema,
199 tag => "schema", methods => [qw/name database extra/], end_tag => 0 );
204 $xml->startTag( [ $Namespace => "tables" ] );
205 for my $table ( $schema->get_tables ) {
206 debug "Table:",$table->name;
207 xml_obj($xml, $table,
209 methods => [qw/name order extra/],
216 xml_obj_children( $xml, $table,
219 name data_type size is_nullable default_value is_auto_increment
220 is_primary_key is_foreign_key extra comments order
227 xml_obj_children( $xml, $table,
229 collection_tag => "indices",
230 methods => [qw/name type fields options extra/],
236 xml_obj_children( $xml, $table,
239 name type fields reference_table reference_fields
240 on_delete on_update match_type expression options deferrable
248 xml_obj_children( $xml, $table,
250 collection_tag => "comments",
256 $xml->endTag( [ $Namespace => 'table' ] );
258 $xml->endTag( [ $Namespace => 'tables' ] );
263 xml_obj_children( $xml, $schema,
265 methods => [qw/name sql fields order extra/],
271 xml_obj_children( $xml, $schema,
273 methods => [qw/name database_events action on_table perform_action_when
274 fields order extra/],
280 xml_obj_children( $xml, $schema,
282 methods => [qw/name sql parameters owner comments order extra/],
285 $xml->endTag([ $Namespace => 'schema' ]);
293 # Takes and XML::Write object, Schema::* parent object, the tag name,
294 # the collection name and a list of methods (of the children) to write as XML.
295 # The collection name defaults to the name with an s on the end and is used to
296 # work out the method to get the children with. eg a name of 'foo' gives a
297 # collection of foos and gets the members using ->get_foos.
299 sub xml_obj_children {
300 my ($xml,$parent) = (shift,shift);
302 my ($name,$collection_name,$methods)
303 = @args{qw/tag collection_tag methods/};
304 $collection_name ||= "${name}s";
307 if ( $collection_name eq 'comments' ) {
310 $meth = "get_$collection_name";
313 my @kids = $parent->$meth;
315 $xml->startTag( [ $Namespace => $collection_name ] );
317 for my $obj ( @kids ) {
318 if ( $collection_name eq 'comments' ){
319 $xml->dataElement( [ $Namespace => 'comment' ], $obj );
328 $xml->endTag( [ $Namespace => $collection_name ] );
332 # Takes an XML::Writer, Schema::* object and list of method names
333 # and writes the obect out as XML. All methods values are written as attributes
334 # except for the methods listed in @MAP_AS_ELEMENTS which get written as child
337 # The attributes/tags are written in the same order as the method names are
341 # - Should the Namespace be passed in instead of global? Pass in the same
342 # as Writer ie [ NS => TAGNAME ]
344 my $elements_re = join("|", @MAP_AS_ELEMENTS);
345 $elements_re = qr/^($elements_re)$/;
347 my ($xml, $obj, %args) = @_;
348 my $tag = $args{'tag'} || '';
349 my $end_tag = $args{'end_tag'} || '';
350 my @meths = @{ $args{'methods'} };
353 # Use array to ensure consistant (ie not hash) ordering of attribs
354 # The order comes from the meths list passed in.
357 foreach ( grep { defined $obj->$_ } @meths ) {
358 my $what = m/$elements_re/ ? \@tags : \@attr;
359 my $val = $_ eq 'extra'
362 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
363 push @$what, $_ => $val;
365 my $child_tags = @tags;
366 $end_tag && !$child_tags
367 ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
368 : $xml->startTag( [ $Namespace => $tag ], @attr );
369 while ( my ($name,$val) = splice @tags,0,2 ) {
370 if ( ref $val eq 'HASH' ) {
371 $xml->emptyTag( [ $Namespace => $name ],
372 map { ($_, $val->{$_}) } sort keys %$val );
375 $xml->dataElement( [ $Namespace => $name ], $val );
378 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
383 # -------------------------------------------------------------------
384 # The eyes of fire, the nostrils of air,
385 # The mouth of water, the beard of earth.
387 # -------------------------------------------------------------------
393 Ken Youens-Clark E<lt>kclark@cpan.orgE<gt>,
394 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
395 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
399 L<perl(1)>, L<SQL::Translator>, L<SQL::Translator::Parser::XML::SQLFairy>,
400 L<SQL::Translator::Schema>, L<XML::Writer>.