1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.10 2004-01-29 21:49:19 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 Takes the following extra producer args.
52 =item * emit_empty_tags
54 Default is false, set to true to emit <foo></foo> style tags for undef values
59 Set true to use attributes for values of the schema objects instead of tags.
61 <!-- attrib_values => 0 -->
67 <!-- attrib_values => 1 -->
68 <table name="foo" order="1">
75 Creates XML output of a schema.
80 use vars qw[ $VERSION @EXPORT_OK ];
81 $VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/;
84 use base qw(Exporter);
85 @EXPORT_OK = qw(produce);
88 use SQL::Translator::Utils qw(header_comment debug);
91 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
96 my $translator = shift;
97 my $schema = $translator->schema;
98 $PArgs = $translator->producer_args;
99 my $io = IO::Scalar->new;
100 my $xml = XML::Writer->new(
103 PREFIX_MAP => { $Namespace => $Name },
108 $xml->xmlDecl('UTF-8');
109 $xml->comment(header_comment('', ''));
110 #$xml->startTag([ $Namespace => 'schema' ]);
111 xml_obj($xml, $schema,
112 tag => "schema", methods => [qw/name database/], end_tag => 0 );
117 for my $table ( $schema->get_tables ) {
118 debug "Table:",$table->name;
119 xml_obj($xml, $table,
120 tag => "table", methods => [qw/name order/], end_tag => 0 );
125 $xml->startTag( [ $Namespace => 'fields' ] );
126 for my $field ( $table->get_fields ) {
127 debug " Field:",$field->name;
128 xml_obj($xml, $field,
131 methods =>[qw/name data_type size is_nullable default_value
132 is_auto_increment is_primary_key is_foreign_key comments order
136 $xml->endTag( [ $Namespace => 'fields' ] );
141 $xml->startTag( [ $Namespace => 'indices' ] );
142 for my $index ( $table->get_indices ) {
143 debug "Index:",$index->name;
144 xml_obj($xml, $index,
147 methods =>[qw/ name type fields options/],
150 $xml->endTag( [ $Namespace => 'indices' ] );
155 $xml->startTag( [ $Namespace => 'constraints' ] );
156 for my $index ( $table->get_constraints ) {
157 debug "Constraint:",$index->name;
158 xml_obj($xml, $index,
162 name type fields reference_table reference_fields
163 on_delete on_update match_type expression options deferrable
167 $xml->endTag( [ $Namespace => 'constraints' ] );
169 $xml->endTag( [ $Namespace => 'table' ] );
175 for my $foo ( $schema->get_views ) {
176 xml_obj($xml, $foo, tag => "view",
177 methods => [qw/name sql fields order/], end_tag => 1 );
183 for my $foo ( $schema->get_triggers ) {
184 xml_obj($xml, $foo, tag => "trigger",
185 methods => [qw/name database_event action on_table perform_action_when
186 fields order/], end_tag => 1 );
192 for my $foo ( $schema->get_procedures ) {
193 xml_obj($xml, $foo, tag => "procedure",
194 methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
197 $xml->endTag([ $Namespace => 'schema' ]);
203 # -------------------------------------------------------------------
207 # - Should the Namespace be passed in instead of global? Pass in the same
208 # as Writer ie [ NS => TAGNAME ]
211 my ($xml, $obj, %args) = @_;
212 my $tag = $args{'tag'} || '';
213 my $end_tag = $args{'end_tag'} || '';
214 my $attrib_values = $PArgs->{'attrib_values'} || '';
215 my @meths = @{ $args{'methods'} };
218 if ( $attrib_values and $end_tag ) {
223 if ( $attrib_values ) {
224 # Use array to ensure consistant (ie not hash) ordering of attribs
225 # The order comes from the meths list passes in.
228 ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val);
229 } grep { defined $obj->$_ } @meths;
230 $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
231 : $xml->startTag( [ $Namespace => $tag ], @attr );
234 $xml->startTag( [ $Namespace => $tag ] );
235 xml_objAttr( $xml, $obj, @meths );
238 $xml->endTag( [ $Namespace => $tag ] ) if $end_tag;
241 # -------------------------------------------------------------------
242 # Takes an XML writer, a Schema::* object and a list of methods and
243 # adds the XML for those methods.
246 my ($xml, $obj, @methods) = @_;
247 my $emit_empty = $PArgs->{'emit_empty_tags'};
249 for my $method ( @methods ) {
250 my $val = $obj->$method;
251 debug " ".ref($obj)."->$method=",
252 (defined $val ? "'$val'" : "<UNDEF>");
253 next unless $emit_empty || defined $val;
254 $val = '' if not defined $val;
255 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
256 debug " Adding Attr:".$method."='",$val,"'";
257 $xml->dataElement( [ $Namespace => $method ], $val );
263 # -------------------------------------------------------------------
264 # The eyes of fire, the nostrils of air,
265 # The mouth of water, the beard of earth.
267 # -------------------------------------------------------------------
273 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
274 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
275 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
279 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
280 SQL::Translator::Schema, XML::Writer.