X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FSQL%2FTranslator%2FProducer%2FXML%2FSQLFairy.pm;h=dc8ed87db63bb85736a5e10f07ac75932f8916ff;hb=e0a0c3e1a2698217f21e0e5b6739d56ada6833ba;hp=625e66f68e4b9edf4c4c2756c95a6775cf83f672;hpb=d3422086e661d79a28578bdd9ca64bfedc68fee5;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/SQL/Translator/Producer/XML/SQLFairy.pm b/lib/SQL/Translator/Producer/XML/SQLFairy.pm index 625e66f..dc8ed87 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.10 2004-01-29 21:49:19 grommit Exp $ +# $Id: SQLFairy.pm,v 1.15 2004-07-08 23:39:38 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -43,42 +43,127 @@ SQL::Translator::Producer::XML::SQLFairy - SQLFairy's default XML format print $t->translate; -=head1 ARGS +=head1 DESCRIPTION + +Creates XML output of a schema, in SQLFairy format XML. + +The XML lives in the http://sqlfairy.sourceforge.net/sqlfairy.xml namespace. +With a root element of . + +Objects in the schema are mapped to tags of the same name as the objects class. + +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. + +List valued attributes (such as the list of fields in an index) +get mapped to a comma seperated list of values in the attribute. + +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. + +L's extra attribute (a hash of arbitary data) is +mapped to a tag called extra, with the hash of data as attributes, sorted into +alphabetical order. + +e.g. + + + + -Takes the following extra producer args. + + + + + + + + + + ... + + + + + + +
+ + + 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 =over 4 -=item * emit_empty_tags +=item add_prefix + +Set to true to use the default namespace prefix of 'sqlf', instead of using +the default namespace for +C + +e.g. + + + -Default is false, set to true to emit style tags for undef values -in the schema. + + -=item * attrib_values +=item prefix -Set true to use attributes for values of the schema objects instead of tags. +Set to the namespace prefix you want to use for the +C - - - foo - 1 -
+e.g. - - -
+ + + +=item newlines + +If true (the default) inserts newlines around the XML, otherwise the schema is +written on one line. + +=item indent + +When using newlines the number of whitespace characters to use as the indent. +Default is 2, set to 0 to turn off indenting. =back -=head1 DESCRIPTION +=head1 LEGACY FORMAT + +The previous version of the SQLFairy XML allowed the attributes of the the +schema objects to be written as either xml attributes or as data elements, in +any combination. The old producer could produce attribute only or data element +only versions. While this allowed for lots of flexibility in writing the XML +the result is a great many possible XML formats, not so good for DTD writing, +XPathing etc! So we have moved to a fixed version described above. -Creates XML output of a schema. +This version of the producer will now only produce the new style XML. +To convert your old format files simply pass them through the translator; + + sqlt -f XML-SQLFairy -t XML-SQLFairy schema-old.xml > schema-new.xml =cut use strict; use vars qw[ $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.10 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/; use Exporter; use base qw(Exporter); @@ -86,23 +171,34 @@ use base qw(Exporter); use IO::Scalar; use SQL::Translator::Utils qw(header_comment debug); -use XML::Writer; +BEGIN { + # Will someone fix XML::Writer already? + local $^W = 0; + require XML::Writer; + import XML::Writer; +} my $Namespace = 'http://sqlfairy.sourceforge.net/sqlfairy.xml'; -my $Name = 'sqlt'; +my $Name = 'sqlf'; my $PArgs = {}; sub produce { my $translator = shift; my $schema = $translator->schema; $PArgs = $translator->producer_args; + my $newlines = defined $PArgs->{newlines} ? $PArgs->{newlines} : 1; + my $indent = defined $PArgs->{indent} ? $PArgs->{indent} : 2; my $io = IO::Scalar->new; + + my $prefix = ""; + $prefix = $Name if $PArgs->{add_prefix}; + $prefix = $PArgs->{prefix} if $PArgs->{prefix}; my $xml = XML::Writer->new( OUTPUT => $io, NAMESPACES => 1, - PREFIX_MAP => { $Namespace => $Name }, - DATA_MODE => 1, - DATA_INDENT => 2, + PREFIX_MAP => { $Namespace => $prefix }, + DATA_MODE => $newlines, + DATA_INDENT => $indent, ); $xml->xmlDecl('UTF-8'); @@ -129,7 +225,7 @@ sub produce { tag =>"field", end_tag => 1, methods =>[qw/name data_type size is_nullable default_value - is_auto_increment is_primary_key is_foreign_key comments order + is_auto_increment is_primary_key is_foreign_key extra comments order /], ); } @@ -202,8 +298,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 ] # @@ -211,51 +313,35 @@ 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|extra)$/ ? \@tags : \@attr; + my $val = $_ eq 'extra' + ? { $obj->$_ } + : $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 ) { + if ( ref $val eq 'HASH' ) { + $xml->emptyTag( [ $Namespace => $name ], + map { ($_, $val->{$_}) } sort keys %$val ); + } + else { + $xml->dataElement( [ $Namespace => $name ], $val ); + } } + $xml->endTag( [ $Namespace => $tag ] ) if $child_tags && $end_tag; } 1;