1 package SQL::Translator::Producer::XML::SQLFairy;
3 # -------------------------------------------------------------------
4 # $Id: SQLFairy.pm,v 1.2 2003-08-22 22:22:19 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.2 $ =~ /(\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
134 $xml->endTag( [ $Namespace => 'fields' ] );
139 $xml->startTag( [ $Namespace => 'indices' ] );
140 for my $index ( $table->get_indices ) {
141 debug "Index:",$index->name;
142 xml_obj($xml, $index,
145 methods =>[qw/fields name options type/],
148 $xml->endTag( [ $Namespace => 'indices' ] );
153 $xml->startTag( [ $Namespace => 'constraints' ] );
154 for my $index ( $table->get_constraints ) {
155 debug "Constraint:",$index->name;
156 xml_obj($xml, $index,
160 deferrable expression fields match_type name
161 options on_delete on_update reference_fields
162 reference_table type/],
165 $xml->endTag( [ $Namespace => 'constraints' ] );
167 $xml->endTag( [ $Namespace => 'table' ] );
170 $xml->endTag([ $Namespace => 'schema' ]);
176 # -------------------------------------------------------------------
178 my ($xml, $obj, %args) = @_;
179 my $tag = $args{'tag'} || '';
180 my $end_tag = $args{'end_tag'} || '';
181 my $attrib_values = $PArgs->{'attrib_values'} || '';
182 my @meths = @{ $args{'methods'} };
185 if ( $attrib_values and $end_tag ) {
190 if ( $attrib_values ) {
193 ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val);
195 foreach ( keys %attr ) { delete $attr{$_} unless defined $attr{$_}; }
196 $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], %attr )
197 : $xml->startTag( [ $Namespace => $tag ], %attr );
200 $xml->startTag( [ $Namespace => $tag ] );
201 xml_objAttr( $xml, $obj, @meths );
204 $xml->endTag( [ $Namespace => $tag ] ) if $end_tag;
207 # -------------------------------------------------------------------
208 # Takes an XML writer, a Schema::* object and a list of methods and
209 # adds the XML for those methods.
212 my ($xml, $obj, @methods) = @_;
213 my $emit_empty = $PArgs->{'emit_empty_tags'};
215 for my $method ( @methods ) {
216 my $val = $obj->$method;
217 debug " ".ref($obj)."->$method=",
218 (defined $val ? "'$val'" : "<UNDEF>");
219 next unless $emit_empty || defined $val;
220 $val = '' if not defined $val;
221 $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val;
222 debug " Adding Attr:".$method."='",$val,"'";
223 $xml->dataElement( [ $Namespace => $method ], $val );
229 # -------------------------------------------------------------------
230 # The eyes of fire, the nostrils of air,
231 # The mouth of water, the beard of earth.
233 # -------------------------------------------------------------------
239 Ken Y. Clark E<lt>kclark@cpan.orgE<gt>,
240 Darren Chamberlain E<lt>darren@cpan.orgE<gt>,
241 Mark Addison E<lt>mark.addison@itn.co.ukE<gt>.
245 perl(1), SQL::Translator, SQL::Translator::Parser::XML::SQLFairy,
246 SQL::Translator::Schema, XML::Writer.