From: Mark Addison Date: Thu, 8 Jul 2004 19:05:26 +0000 (+0000) Subject: Updated to produce the new, single format sqlf xml. X-Git-Tag: v0.06~48 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=b89a67a0db17d61a0940612b5e0b8dd2e3103ed9;p=dbsrgits%2FSQL-Translator.git Updated to produce the new, single format sqlf xml. --- diff --git a/lib/SQL/Translator/Producer/XML/SQLFairy.pm b/lib/SQL/Translator/Producer/XML/SQLFairy.pm index bb7ba62..33157b2 100644 --- a/lib/SQL/Translator/Producer/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Producer/XML/SQLFairy.pm @@ -1,7 +1,7 @@ package SQL::Translator::Producer::XML::SQLFairy; # ------------------------------------------------------------------- -# $Id: SQLFairy.pm,v 1.11 2004-03-04 14:39:46 dlc Exp $ +# $Id: SQLFairy.pm,v 1.12 2004-07-08 19:05:26 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -43,42 +43,71 @@ SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format print $t->translate; -=head1 ARGS +=head1 DESCRIPTION -Takes the following extra producer args. +Creates XML output of a schema, in SQLFairy format XML. -=over 4 +The XML lives in the http://sqlfairy.sourceforge.net/sqlfairy.xml namespace. +With a root element of . -=item * emit_empty_tags +Objects in the schema are mapped to tags of the same name as the objects class. -Default is false, set to true to emit style tags for undef values -in the schema. +The attributes of the objects (e.g. $field->name) are mapped to attributes of +the tag, except for sql, comments and action, which get mapped to child data +elements. -=item * attrib_values +List valued attributes (such as the list of fields in an index) +get mapped to a comma seperated list of values in the attribute. -Set true to use attributes for values of the schema objects instead of tags. +Child objects, such as a tables fields, get mapped to child tags wrapped in a +set of container tags using the plural of their contained classes name. - - - foo - 1 -
+e.g. - - -
+ -=back + -=head1 DESCRIPTION + + + + + + + + ... + + + + + + +
+ + + SELECT email FROM Basic WHERE email IS NOT NULL + + + + +To see a complete example of the XML translate one of your schema :) + + $ sqlt -f MySQL -t XML-SQLFairy schema.sql + +=head1 ARGS -Creates XML output of a schema. +Doesn't take any extra arguments. =cut use strict; use vars qw[ $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.11 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.12 $ =~ /(\d+)\.(\d+)/; use Exporter; use base qw(Exporter); @@ -94,7 +123,7 @@ BEGIN { } my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml'; -my $Name = 'sqlt'; +my $Name = 'sqlf'; my $PArgs = {}; sub produce { @@ -207,8 +236,14 @@ sub produce { # ------------------------------------------------------------------- # -# TODO -# - Doc this sub +# Takes an XML Write, Schema::* object and list of method names +# and writes the obect out as XML. All methods values are written as attributes +# except for comments, sql and action which get written as child data elements. +# +# The attributes, tags are written in the same order as the method names are +# passed. +# +# TODO # - Should the Namespace be passed in instead of global? Pass in the same # as Writer ie [ NS => TAGNAME ] # @@ -216,51 +251,27 @@ sub xml_obj { my ($xml, $obj, %args) = @_; my $tag = $args{'tag'} || ''; my $end_tag = $args{'end_tag'} || ''; - my $attrib_values = $PArgs->{'attrib_values'} || ''; my @meths = @{ $args{'methods'} }; my $empty_tag = 0; - if ( $attrib_values and $end_tag ) { - $empty_tag = 1; - $end_tag = 0; - } - - if ( $attrib_values ) { - # Use array to ensure consistant (ie not hash) ordering of attribs - # The order comes from the meths list passes in. - my @attr = map { - my $val = $obj->$_; - ($_ => ref($val) eq 'ARRAY' ? join(', ', @$val) : $val); - } grep { defined $obj->$_ } @meths; - $empty_tag ? $xml->emptyTag( [ $Namespace => $tag ], @attr ) - : $xml->startTag( [ $Namespace => $tag ], @attr ); - } - else { - $xml->startTag( [ $Namespace => $tag ] ); - xml_objAttr( $xml, $obj, @meths ); - } - - $xml->endTag( [ $Namespace => $tag ] ) if $end_tag; -} - -# ------------------------------------------------------------------- -# Takes an XML writer, a Schema::* object and a list of methods and -# adds the XML for those methods. -# -sub xml_objAttr { - my ($xml, $obj, @methods) = @_; - my $emit_empty = $PArgs->{'emit_empty_tags'}; - - for my $method ( @methods ) { - my $val = $obj->$method; - debug " ".ref($obj)."->$method=", - (defined $val ? "'$val'" : ""); - next unless $emit_empty || defined $val; - $val = '' if not defined $val; + # Use array to ensure consistant (ie not hash) ordering of attribs + # The order comes from the meths list passed in. + my @tags; + my @attr; + foreach ( grep { defined $obj->$_ } @meths ) { + my $what = m/^sql|comments|action$/ ? \@tags : \@attr; + my $val = $obj->$_; $val = ref $val eq 'ARRAY' ? join(',', @$val) : $val; - debug " Adding Attr:".$method."='",$val,"'"; - $xml->dataElement( [ $Namespace => $method ], $val ); + push @$what, $_ => $val; + }; + my $child_tags = @tags; + $end_tag && !$child_tags + ? $xml->emptyTag( [ $Namespace => $tag ], @attr ) + : $xml->startTag( [ $Namespace => $tag ], @attr ); + while ( my ($name,$val) = splice @tags,0,2 ) { + $xml->dataElement( [ $Namespace => $name ], $val ); } + $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag; } 1;