1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.12 2004-07-08 19:05: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
104 Doesn't take any extra arguments.
109 use vars qw[ $VERSION @EXPORT_OK ];
110 $VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/;
113 use base qw(Exporter);
114 @EXPORT_OK = qw(produce);
117 use SQL::Translator::Utils qw(header_comment debug);
119 # Will someone fix XML::Writer already?
125 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
130 my $translator = shift;
131 my $schema = $translator->schema;
132 $PArgs = $translator->producer_args;
133 my $io = IO::Scalar->new;
134 my $xml = XML::Writer->new(
137 PREFIX_MAP => { $Namespace => $Name },
142 $xml->xmlDecl('UTF-8');
143 $xml->comment(header_comment('', ''));
144 #$xml->startTag([ $Namespace => 'schema' ]);
145 xml_obj($xml, $schema,
146 tag => "schema", methods => [qw/name database/], end_tag => 0 );
151 for my $table ( $schema->get_tables ) {
152 debug "Table:",$table->name;
153 xml_obj($xml, $table,
154 tag => "table", methods => [qw/name order/], end_tag => 0 );
159 $xml->startTag( [ $Namespace => 'fields' ] );
160 for my $field ( $table->get_fields ) {
161 debug " Field:",$field->name;
162 xml_obj($xml, $field,
165 methods =>[qw/name data_type size is_nullable default_value
166 is_auto_increment is_primary_key is_foreign_key comments order
170 $xml->endTag( [ $Namespace => 'fields' ] );
175 $xml->startTag( [ $Namespace => 'indices' ] );
176 for my $index ( $table->get_indices ) {
177 debug "Index:",$index->name;
178 xml_obj($xml, $index,
181 methods =>[qw/ name type fields options/],
184 $xml->endTag( [ $Namespace => 'indices' ] );
189 $xml->startTag( [ $Namespace => 'constraints' ] );
190 for my $index ( $table->get_constraints ) {
191 debug "Constraint:",$index->name;
192 xml_obj($xml, $index,
196 name type fields reference_table reference_fields
197 on_delete on_update match_type expression options deferrable
201 $xml->endTag( [ $Namespace => 'constraints' ] );
203 $xml->endTag( [ $Namespace => 'table' ] );
209 for my $foo ( $schema->get_views ) {
210 xml_obj($xml, $foo, tag => "view",
211 methods => [qw/name sql fields order/], end_tag => 1 );
217 for my $foo ( $schema->get_triggers ) {
218 xml_obj($xml, $foo, tag => "trigger",
219 methods => [qw/name database_event action on_table perform_action_when
220 fields order/], end_tag => 1 );
226 for my $foo ( $schema->get_procedures ) {
227 xml_obj($xml, $foo, tag => "procedure",
228 methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
231 $xml->endTag([ $Namespace => 'schema' ]);
237 # -------------------------------------------------------------------
239 # Takes an XML Write, Schema::* object and list of method names
240 # and writes the obect out as XML. All methods values are written as attributes
241 # except for comments, sql and action which get written as child data elements.
243 # The attributes, tags are written in the same order as the method names are
247 # - Should the Namespace be passed in instead of global? Pass in the same
248 # as Writer ie [ NS => TAGNAME ]
251 my ($xml, $obj, %args) = @_;
252 my $tag = $args{'tag'} || '';
253 my $end_tag = $args{'end_tag'} || '';
254 my @meths = @{ $args{'methods'} };
257 # Use array to ensure consistant (ie not hash) ordering of attribs
258 # The order comes from the meths list passed in.
261 foreach ( grep { defined $obj->$_ } @meths ) {
262 my $what = m/^sql|comments|action$/ ? \@tags : \@attr;
264 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
265 push @$what, $_ => $val;
267 my $child_tags = @tags;
268 $end_tag && !$child_tags
269 ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
270 : $xml->startTag( [ $Namespace => $tag ], @attr );
271 while ( my ($name,$val) = splice @tags,0,2 ) {
272 $xml->dataElement( [ $Namespace => $name ], $val );
274 $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag;
279 # -------------------------------------------------------------------
280 # The eyes of fire, the nostrils of air,
281 # The mouth of water, the beard of earth.
283 # -------------------------------------------------------------------
289 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
290 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
291 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
295 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
296 SQL::Translator::Schema, XML::Writer.