1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.14 2004-07-08 20:37:26 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.
67 <schema name="" database=""
68 xmlns="http://sqlfairy.sourceforge.net/sqlfairy.xml">
70 <table name="Story" order="1">
73 <field name="created" data_type="datetime" size="0"
74 is_nullable="1" is_auto_increment="0" is_primary_key="0"
75 is_foreign_key="0" order="1">
78 <field name="id" data_type="BIGINT" size="20"
79 is_nullable="0" is_auto_increment="1" is_primary_key="1"
80 is_foreign_key="0" order="3">
87 <index name="foobar" type="NORMAL" fields="foo,bar" options="" />
92 <view name="email_list" fields="email" order="1">
93 <sql>SELECT email FROM Basic WHERE email IS NOT NULL</sql>
98 To see a complete example of the XML translate one of your schema :)
100 $ sqlt -f MySQL -t XML-SQLFairy schema.sql
108 Set to true to use the default namespace prefix of 'sqlf', instead of using
109 the default namespace for
110 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
114 <!-- add_prefix=0 -->
117 <!-- add_prefix=1 -->
118 <sqlf:field name="foo" />
122 Set to the namespace prefix you want to use for the
123 C<http://sqlfairy.sourceforge.net/sqlfairy.xml namespace>
127 <!-- prefix='foo' -->
128 <foo:field name="foo" />
134 The previous version of the SQLFairy XML allowed the attributes of the the
135 schema objects to be written as either xml attributes or as data elements, in
136 any combination. The old producer could produce attribute only or data element
137 only versions. While this allowed for lots of flexibility in writing the XML
138 the result is a great many possible XML formats, not so good for DTD writing,
139 XPathing etc! So we have moved to a fixed version described above.
141 This version of the producer will now only produce the new style XML.
142 To convert your old format files simply pass them through the translator;
144 sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml
149 use vars qw[ $VERSION @EXPORT_OK ];
150 $VERSION = sprintf "%d.%02d", q$Revision: 1.14 $ =~ /(\d+)\.(\d+)/;
153 use base qw(Exporter);
154 @EXPORT_OK = qw(produce);
157 use SQL::Translator::Utils qw(header_comment debug);
159 # Will someone fix XML::Writer already?
165 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
170 my $translator = shift;
171 my $schema = $translator->schema;
172 $PArgs = $translator->producer_args;
173 my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1;
174 my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2;
175 my $io = IO::Scalar->new;
178 $prefix = $Name if $PArgs->{add_prefix};
179 $prefix = $PArgs->{prefix} if $PArgs->{prefix};
180 my $xml = XML::Writer->new(
183 PREFIX_MAP => { $Namespace => $prefix },
184 DATA_MODE => $newlines,
185 DATA_INDENT => $indent,
188 $xml->xmlDecl('UTF-8');
189 $xml->comment(header_comment('', ''));
190 #$xml->startTag([ $Namespace => 'schema' ]);
191 xml_obj($xml, $schema,
192 tag => "schema", methods => [qw/name database/], end_tag => 0 );
197 for my $table ( $schema->get_tables ) {
198 debug "Table:",$table->name;
199 xml_obj($xml, $table,
200 tag => "table", methods => [qw/name order/], end_tag => 0 );
205 $xml->startTag( [ $Namespace => 'fields' ] );
206 for my $field ( $table->get_fields ) {
207 debug " Field:",$field->name;
208 xml_obj($xml, $field,
211 methods =>[qw/name data_type size is_nullable default_value
212 is_auto_increment is_primary_key is_foreign_key comments order
216 $xml->endTag( [ $Namespace => 'fields' ] );
221 $xml->startTag( [ $Namespace => 'indices' ] );
222 for my $index ( $table->get_indices ) {
223 debug "Index:",$index->name;
224 xml_obj($xml, $index,
227 methods =>[qw/ name type fields options/],
230 $xml->endTag( [ $Namespace => 'indices' ] );
235 $xml->startTag( [ $Namespace => 'constraints' ] );
236 for my $index ( $table->get_constraints ) {
237 debug "Constraint:",$index->name;
238 xml_obj($xml, $index,
242 name type fields reference_table reference_fields
243 on_delete on_update match_type expression options deferrable
247 $xml->endTag( [ $Namespace => 'constraints' ] );
249 $xml->endTag( [ $Namespace => 'table' ] );
255 for my $foo ( $schema->get_views ) {
256 xml_obj($xml, $foo, tag => "view",
257 methods => [qw/name sql fields order/], end_tag => 1 );
263 for my $foo ( $schema->get_triggers ) {
264 xml_obj($xml, $foo, tag => "trigger",
265 methods => [qw/name database_event action on_table perform_action_when
266 fields order/], end_tag => 1 );
272 for my $foo ( $schema->get_procedures ) {
273 xml_obj($xml, $foo, tag => "procedure",
274 methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
277 $xml->endTag([ $Namespace => 'schema' ]);
283 # -------------------------------------------------------------------
285 # Takes an XML Write, Schema::* object and list of method names
286 # and writes the obect out as XML. All methods values are written as attributes
287 # except for comments, sql and action which get written as child data elements.
289 # The attributes, tags are written in the same order as the method names are
293 # - Should the Namespace be passed in instead of global? Pass in the same
294 # as Writer ie [ NS => TAGNAME ]
297 my ($xml, $obj, %args) = @_;
298 my $tag = $args{'tag'} || '';
299 my $end_tag = $args{'end_tag'} || '';
300 my @meths = @{ $args{'methods'} };
303 # Use array to ensure consistant (ie not hash) ordering of attribs
304 # The order comes from the meths list passed in.
307 foreach ( grep { defined $obj->$_ } @meths ) {
308 my $what = m/^sql|comments|action$/ ? \@tags : \@attr;
310 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
311 push @$what, $_ => $val;
313 my $child_tags = @tags;
314 $end_tag && !$child_tags
315 ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
316 : $xml->startTag( [ $Namespace => $tag ], @attr );
317 while ( my ($name,$val) = splice @tags,0,2 ) {
318 $xml->dataElement( [ $Namespace => $name ], $val );
320 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
325 # -------------------------------------------------------------------
326 # The eyes of fire, the nostrils of air,
327 # The mouth of water, the beard of earth.
329 # -------------------------------------------------------------------
335 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
336 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
337 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
341 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
342 SQL::Translator::Schema, XML::Writer.