1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.16 2004-08-18 20:27:58 grommit Exp $
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>.
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.
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.
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
24 # -------------------------------------------------------------------
30 SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format
36 my $t = SQL::Translator->new(
39 filename => 'schema.sql',
48 Creates XML output of a schema, in SQLFairy format XML.
50 The XML lives in the http://sqlfairy.sourceforge.net/sqlfairy.xml namespace.
51 With a root element of <schema>.
53 Objects in the schema are mapped to tags of the same name as the objects class.
55 The attributes of the objects (e.g. $field->name) are mapped to attributes of
56 the tag, except for sql, comments and action, which get mapped to child data
59 List valued attributes (such as the list of fields in an index)
60 get mapped to a comma seperated list of values in the attribute.
62 Child objects, such as a tables fields, get mapped to child tags wrapped in a
63 set of container tags using the plural of their contained classes name.
65 L<SQL::Translator::Schema::Field>'s extra attribute (a hash of arbitary data) is
66 mapped to a tag called extra, with the hash of data as attributes, sorted into
71 <schema name="" database=""
72 xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
74 <table name="Story" order="1">
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">
80 <extra ZEROFILL="1" />
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">
93 <index name="foobar" type="NORMAL" fields="foo,bar" options="" />
98 <view name="email_list" fields="email" order="1">
99 <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
104 To see a complete example of the XML translate one of your schema :)
106 $ sqlt -f MySQL -t XML-SQLFairy schema.sql
114 Set to true to use the default namespace prefix of 'sqlf', instead of using
115 the default namespace for
116 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
120 <!-- add_prefix=0 -->
123 <!-- add_prefix=1 -->
124 <sqlf:field name="foo" />
128 Set to the namespace prefix you want to use for the
129 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
133 <!-- prefix='foo' -->
134 <foo:field name="foo" />
138 If true (the default) inserts newlines around the XML, otherwise the schema is
143 When using newlines the number of whitespace characters to use as the indent.
144 Default is 2, set to 0 to turn off indenting.
150 The previous version of the SQLFairy XML allowed the attributes of the the
151 schema objects to be written as either xml attributes or as data elements, in
152 any combination. The old producer could produce attribute only or data element
153 only versions. While this allowed for lots of flexibility in writing the XML
154 the result is a great many possible XML formats, not so good for DTD writing,
155 XPathing etc! So we have moved to a fixed version described above.
157 This version of the producer will now only produce the new style XML.
158 To convert your old format files simply pass them through the translator;
160 sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
165 use vars qw[ $VERSION @EXPORT_OK ];
166 $VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/;
169 use base qw(Exporter);
170 @EXPORT_OK = qw(produce);
173 use SQL::Translator::Utils qw(header_comment debug);
175 # Will someone fix XML::Writer already?
181 # Which schema object attributes (methods) to write as xml elements rather than
182 # as attributes. e.g. <comments>blah, blah...</comments>
183 my @MAP_AS_ELEMENTS = qw/sql comments action extra/;
187 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
192 my $translator = shift;
193 my $schema = $translator->schema;
194 $PArgs = $translator->producer_args;
195 my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
196 my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
197 my $io = IO::Scalar->new;
199 # Setup the XML::Writer and set the namespace
201 $prefix = $Name if $PArgs->{add_prefix};
202 $prefix = $PArgs->{prefix} if $PArgs->{prefix};
203 my $xml = XML::Writer->new(
206 PREFIX_MAP => { $Namespace => $prefix },
207 DATA_MODE => $newlines,
208 DATA_INDENT => $indent,
212 $xml->xmlDecl('UTF-8');
213 $xml->comment(header_comment('', ''));
214 xml_obj($xml, $schema,
215 tag => "schema", methods => [qw/name database/], end_tag => 0 );
220 for my $table ( $schema->get_tables ) {
221 debug "Table:",$table->name;
222 xml_obj($xml, $table,
223 tag => "table", methods => [qw/name order/], end_tag => 0 );
228 $xml->startTag( [ $Namespace => 'fields' ] );
229 for my $field ( $table->get_fields ) {
230 debug " Field:",$field->name;
231 xml_obj($xml, $field,
234 methods =>[qw/name data_type size is_nullable default_value
235 is_auto_increment is_primary_key is_foreign_key extra comments order
239 $xml->endTag( [ $Namespace => 'fields' ] );
244 $xml->startTag( [ $Namespace => 'indices' ] );
245 for my $index ( $table->get_indices ) {
246 debug "Index:",$index->name;
247 xml_obj($xml, $index,
250 methods =>[qw/ name type fields options/],
253 $xml->endTag( [ $Namespace => 'indices' ] );
258 $xml->startTag( [ $Namespace => 'constraints' ] );
259 for my $index ( $table->get_constraints ) {
260 debug "Constraint:",$index->name;
261 xml_obj($xml, $index,
265 name type fields reference_table reference_fields
266 on_delete on_update match_type expression options deferrable
270 $xml->endTag( [ $Namespace => 'constraints' ] );
272 $xml->endTag( [ $Namespace => 'table' ] );
278 for my $foo ( $schema->get_views ) {
279 xml_obj($xml, $foo, tag => "view",
280 methods => [qw/name sql fields order/], end_tag => 1 );
286 for my $foo ( $schema->get_triggers ) {
287 xml_obj($xml, $foo, tag => "trigger",
288 methods => [qw/name database_event action on_table perform_action_when
289 fields order/], end_tag => 1 );
295 for my $foo ( $schema->get_procedures ) {
296 xml_obj($xml, $foo, tag => "procedure",
297 methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
300 $xml->endTag([ $Namespace => 'schema' ]);
306 # -------------------------------------------------------------------
308 # Takes an XML::Writer, Schema::* object and list of method names
309 # and writes the obect out as XML. All methods values are written as attributes
310 # except for comments, sql and action which get written as child data elements.
312 # The attributes/tags are written in the same order as the method names are
316 # - Should the Namespace be passed in instead of global? Pass in the same
317 # as Writer ie [ NS => TAGNAME ]
319 my $elements_re = join("|", @MAP_AS_ELEMENTS);
320 $elements_re = qr/^($elements_re)$/;
322 my ($xml, $obj, %args) = @_;
323 my $tag = $args{'tag'} || '';
324 my $end_tag = $args{'end_tag'} || '';
325 my @meths = @{ $args{'methods'} };
328 # Use array to ensure consistant (ie not hash) ordering of attribs
329 # The order comes from the meths list passed in.
332 foreach ( grep { defined $obj->$_ } @meths ) {
333 my $what = m/$elements_re/ ? \@tags : \@attr;
334 my $val = $_ eq 'extra'
337 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
338 push @$what, $_ => $val;
340 my $child_tags = @tags;
341 $end_tag && !$child_tags
342 ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
343 : $xml->startTag( [ $Namespace => $tag ], @attr );
344 while ( my ($name,$val) = splice @tags,0,2 ) {
345 if ( ref $val eq 'HASH' ) {
346 $xml->emptyTag( [ $Namespace => $name ],
347 map { ($_, $val->{$_}) } sort keys %$val );
350 $xml->dataElement( [ $Namespace => $name ], $val );
353 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
358 # -------------------------------------------------------------------
359 # The eyes of fire, the nostrils of air,
360 # The mouth of water, the beard of earth.
362 # -------------------------------------------------------------------
368 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
369 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
370 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
374 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
375 SQL::Translator::Schema, XML::Writer.