1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.4 2003-09-09 16:05:09 kycl4rk 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.4 $ =~ /(\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' ]);
115 for my $table ( $schema->get_tables ) {
116 debug "Table:",$table->name;
117 xml_obj($xml, $table,
118 tag => "table", methods => [qw/name order/], end_tag => 0 );
123 $xml->startTag( [ $Namespace => 'fields' ] );
124 for my $field ( $table->get_fields ) {
125 debug " Field:",$field->name;
126 xml_obj($xml, $field,
129 methods =>[qw/name data_type default_value is_auto_increment
130 is_primary_key is_nullable is_foreign_key order size
135 $xml->endTag( [ $Namespace => 'fields' ] );
140 $xml->startTag( [ $Namespace => 'indices' ] );
141 for my $index ( $table->get_indices ) {
142 debug "Index:",$index->name;
143 xml_obj($xml, $index,
146 methods =>[qw/fields name options type/],
149 $xml->endTag( [ $Namespace => 'indices' ] );
154 $xml->startTag( [ $Namespace => 'constraints' ] );
155 for my $index ( $table->get_constraints ) {
156 debug "Constraint:",$index->name;
157 xml_obj($xml, $index,
161 deferrable expression fields match_type name
162 options on_delete on_update reference_fields
163 reference_table type/],
166 $xml->endTag( [ $Namespace => 'constraints' ] );
168 $xml->endTag( [ $Namespace => 'table' ] );
171 $xml->endTag([ $Namespace => 'schema' ]);
177 # -------------------------------------------------------------------
179 my ($xml, $obj, %args) = @_;
180 my $tag = $args{'tag'} || '';
181 my $end_tag = $args{'end_tag'} || '';
182 my $attrib_values = $PArgs->{'attrib_values'} || '';
183 my @meths = @{ $args{'methods'} };
186 if ( $attrib_values and $end_tag ) {
191 if ( $attrib_values ) {
194 ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val);
196 foreach ( keys %attr ) { delete $attr{$_} unless defined $attr{$_}; }
197 $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], %attr )
198 : $xml->startTag( [ $Namespace => $tag ], %attr );
201 $xml->startTag( [ $Namespace => $tag ] );
202 xml_objAttr( $xml, $obj, @meths );
205 $xml->endTag( [ $Namespace => $tag ] ) if $end_tag;
208 # -------------------------------------------------------------------
209 # Takes an XML writer, a Schema::* object and a list of methods and
210 # adds the XML for those methods.
213 my ($xml, $obj, @methods) = @_;
214 my $emit_empty = $PArgs->{'emit_empty_tags'};
216 for my $method ( @methods ) {
217 my $val = $obj->$method;
218 debug " ".ref($obj)."->$method=",
219 (defined $val ? "'$val'" : "<UNDEF>");
220 next unless $emit_empty || defined $val;
221 $val = '' if not defined $val;
222 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
223 debug " Adding Attr:".$method."='",$val,"'";
224 $xml->dataElement( [ $Namespace => $method ], $val );
230 # -------------------------------------------------------------------
231 # The eyes of fire, the nostrils of air,
232 # The mouth of water, the beard of earth.
234 # -------------------------------------------------------------------
240 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
241 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
242 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
246 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
247 SQL::Translator::Schema, XML::Writer.