1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.11 2004-03-04 14:39:46 dlc 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.11 $ =~ /(\d+)\.(\d+)/;
84 use base qw(Exporter);
85 @EXPORT_OK = qw(produce);
88 use SQL::Translator::Utils qw(header_comment debug);
90 # Will someone fix XML::Writer already?
96 my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml';
101 my $translator = shift;
102 my $schema = $translator->schema;
103 $PArgs = $translator->producer_args;
104 my $io = IO::Scalar->new;
105 my $xml = XML::Writer->new(
108 PREFIX_MAP => { $Namespace => $Name },
113 $xml->xmlDecl('UTF-8');
114 $xml->comment(header_comment('', ''));
115 #$xml->startTag([ $Namespace => 'schema' ]);
116 xml_obj($xml, $schema,
117 tag => "schema", methods => [qw/name database/], end_tag => 0 );
122 for my $table ( $schema->get_tables ) {
123 debug "Table:",$table->name;
124 xml_obj($xml, $table,
125 tag => "table", methods => [qw/name order/], end_tag => 0 );
130 $xml->startTag( [ $Namespace => 'fields' ] );
131 for my $field ( $table->get_fields ) {
132 debug " Field:",$field->name;
133 xml_obj($xml, $field,
136 methods =>[qw/name data_type size is_nullable default_value
137 is_auto_increment is_primary_key is_foreign_key comments order
141 $xml->endTag( [ $Namespace => 'fields' ] );
146 $xml->startTag( [ $Namespace => 'indices' ] );
147 for my $index ( $table->get_indices ) {
148 debug "Index:",$index->name;
149 xml_obj($xml, $index,
152 methods =>[qw/ name type fields options/],
155 $xml->endTag( [ $Namespace => 'indices' ] );
160 $xml->startTag( [ $Namespace => 'constraints' ] );
161 for my $index ( $table->get_constraints ) {
162 debug "Constraint:",$index->name;
163 xml_obj($xml, $index,
167 name type fields reference_table reference_fields
168 on_delete on_update match_type expression options deferrable
172 $xml->endTag( [ $Namespace => 'constraints' ] );
174 $xml->endTag( [ $Namespace => 'table' ] );
180 for my $foo ( $schema->get_views ) {
181 xml_obj($xml, $foo, tag => "view",
182 methods => [qw/name sql fields order/], end_tag => 1 );
188 for my $foo ( $schema->get_triggers ) {
189 xml_obj($xml, $foo, tag => "trigger",
190 methods => [qw/name database_event action on_table perform_action_when
191 fields order/], end_tag => 1 );
197 for my $foo ( $schema->get_procedures ) {
198 xml_obj($xml, $foo, tag => "procedure",
199 methods => [qw/name sql parameters owner comments order/], end_tag=>1 );
202 $xml->endTag([ $Namespace => 'schema' ]);
208 # -------------------------------------------------------------------
212 # - Should the Namespace be passed in instead of global? Pass in the same
213 # as Writer ie [ NS => TAGNAME ]
216 my ($xml, $obj, %args) = @_;
217 my $tag = $args{'tag'} || '';
218 my $end_tag = $args{'end_tag'} || '';
219 my $attrib_values = $PArgs->{'attrib_values'} || '';
220 my @meths = @{ $args{'methods'} };
223 if ( $attrib_values and $end_tag ) {
228 if ( $attrib_values ) {
229 # Use array to ensure consistant (ie not hash) ordering of attribs
230 # The order comes from the meths list passes in.
233 ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val);
234 } grep { defined $obj->$_ } @meths;
235 $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], @attr )
236 : $xml->startTag( [ $Namespace => $tag ], @attr );
239 $xml->startTag( [ $Namespace => $tag ] );
240 xml_objAttr( $xml, $obj, @meths );
243 $xml->endTag( [ $Namespace => $tag ] ) if $end_tag;
246 # -------------------------------------------------------------------
247 # Takes an XML writer, a Schema::* object and a list of methods and
248 # adds the XML for those methods.
251 my ($xml, $obj, @methods) = @_;
252 my $emit_empty = $PArgs->{'emit_empty_tags'};
254 for my $method ( @methods ) {
255 my $val = $obj->$method;
256 debug " ".ref($obj)."->$method=",
257 (defined $val ? "'$val'" : "<UNDEF>");
258 next unless $emit_empty || defined $val;
259 $val = '' if not defined $val;
260 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
261 debug " Adding Attr:".$method."='",$val,"'";
262 $xml->dataElement( [ $Namespace => $method ], $val );
268 # -------------------------------------------------------------------
269 # The eyes of fire, the nostrils of air,
270 # The mouth of water, the beard of earth.
272 # -------------------------------------------------------------------
278 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
279 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
280 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
284 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
285 SQL::Translator::Schema, XML::Writer.