From: Mark Addison Date: Thu, 19 Aug 2004 14:09:00 +0000 (+0000) Subject: Added collection tags for the Schemas objects (tables, views, etc) X-Git-Tag: v0.06~10 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=87c5565efa0003b1cf1fcbd08b3b6891cd0c957b;hp=23735f6ad64bd9f1aa3d5290cdc50dbe86c058db;p=dbsrgits%2FSQL-Translator.git Added collection tags for the Schemas objects (tables, views, etc) --- diff --git a/lib/SQL/Translator/Parser/XML/SQLFairy.pm b/lib/SQL/Translator/Parser/XML/SQLFairy.pm index f8af966..d4a06ad 100644 --- a/lib/SQL/Translator/Parser/XML/SQLFairy.pm +++ b/lib/SQL/Translator/Parser/XML/SQLFairy.pm @@ -1,7 +1,7 @@ package SQL::Translator::Parser::XML::SQLFairy; # ------------------------------------------------------------------- -# $Id: SQLFairy.pm,v 1.8 2004-07-09 00:50:06 grommit Exp $ +# $Id: SQLFairy.pm,v 1.9 2004-08-19 14:08:59 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -103,7 +103,7 @@ To convert your old format files simply pass them through the translator; use strict; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.8 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.9 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -127,7 +127,9 @@ sub parse { # # Work our way through the tables # - my @nodes = $xp->findnodes('/sqlf:schema/sqlf:table'); + my @nodes = $xp->findnodes( + '/sqlf:schema/sqlf:table|/sqlf:schema/sqlf:tables/sqlf:table' + ); for my $tblnode ( sort { "".$xp->findvalue('sqlf:order|@order',$a) @@ -207,7 +209,9 @@ sub parse { # # Views # - @nodes = $xp->findnodes('/sqlf:schema/sqlf:view'); + @nodes = $xp->findnodes( + '/sqlf:schema/sqlf:view|/sqlf:schema/sqlf:views/sqlf:view' + ); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", qw/name sql fields order/ @@ -218,7 +222,9 @@ sub parse { # # Triggers # - @nodes = $xp->findnodes('/sqlf:schema/sqlf:trigger'); + @nodes = $xp->findnodes( + '/sqlf:schema/sqlf:trigger|/sqlf:schema/sqlf:triggers/sqlf:trigger' + ); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", qw/name perform_action_when database_event fields on_table action order/ @@ -229,7 +235,9 @@ sub parse { # # Procedures # - @nodes = $xp->findnodes('/sqlf:schema/sqlf:procedure'); + @nodes = $xp->findnodes( + '/sqlf:schema/sqlf:procedure|/sqlf:schema/sqlf:procedures/sqlf:procedure' + ); foreach (@nodes) { my %data = get_tagfields($xp, $_, "sqlf:", qw/name sql parameters owner comments order/ diff --git a/lib/SQL/Translator/Producer/XML/SQLFairy.pm b/lib/SQL/Translator/Producer/XML/SQLFairy.pm index c956383..73fa851 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.16 2004-08-18 20:27:58 grommit Exp $ +# $Id: SQLFairy.pm,v 1.17 2004-08-19 14:09:00 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Ken Y. Clark , # darren chamberlain , @@ -163,7 +163,7 @@ To convert your old format files simply pass them through the translator; use strict; use vars qw[ $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.16 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.17 $ =~ /(\d+)\.(\d+)/; use Exporter; use base qw(Exporter); @@ -217,85 +217,74 @@ sub produce { # # Table # + $xml->startTag( [ $Namespace => "tables" ] ); for my $table ( $schema->get_tables ) { debug "Table:",$table->name; xml_obj($xml, $table, - tag => "table", methods => [qw/name order/], end_tag => 0 ); + tag => "table", + methods => [qw/name order/], + end_tag => 0 + ); # # Fields # - $xml->startTag( [ $Namespace => 'fields' ] ); - for my $field ( $table->get_fields ) { - debug " Field:",$field->name; - xml_obj($xml, $field, - tag =>"field", - end_tag => 1, - methods =>[qw/name data_type size is_nullable default_value - is_auto_increment is_primary_key is_foreign_key extra comments order - /], - ); - } - $xml->endTag( [ $Namespace => 'fields' ] ); + xml_obj_children( $xml, $table, + tag => 'field', + methods =>[qw/ + name data_type size is_nullable default_value is_auto_increment + is_primary_key is_foreign_key extra comments order + /], + ); # # Indices # - $xml->startTag( [ $Namespace => 'indices' ] ); - for my $index ( $table->get_indices ) { - debug "Index:",$index->name; - xml_obj($xml, $index, - tag => "index", - end_tag => 1, - methods =>[qw/ name type fields options/], - ); - } - $xml->endTag( [ $Namespace => 'indices' ] ); + xml_obj_children( $xml, $table, + tag => 'index', + collection_tag => "indices", + methods => [qw/name type fields options/], + ); # # Constraints # - $xml->startTag( [ $Namespace => 'constraints' ] ); - for my $index ( $table->get_constraints ) { - debug "Constraint:",$index->name; - xml_obj($xml, $index, - tag => "constraint", - end_tag => 1, - methods =>[qw/ - name type fields reference_table reference_fields - on_delete on_update match_type expression options deferrable - /], - ); - } - $xml->endTag( [ $Namespace => 'constraints' ] ); + xml_obj_children( $xml, $table, + tag => 'constraint', + methods => [qw/ + name type fields reference_table reference_fields + on_delete on_update match_type expression options deferrable + /], + ); $xml->endTag( [ $Namespace => 'table' ] ); } + $xml->endTag( [ $Namespace => 'tables' ] ); # # Views # - for my $foo ( $schema->get_views ) { - xml_obj($xml, $foo, tag => "view", - methods => [qw/name sql fields order/], end_tag => 1 ); - } + xml_obj_children( $xml, $schema, + tag => 'view', + methods => [qw/name sql fields order/], + ); # # Tiggers # - for my $foo ( $schema->get_triggers ) { - xml_obj($xml, $foo, tag => "trigger", + xml_obj_children( $xml, $schema, + tag => 'trigger', methods => [qw/name database_event action on_table perform_action_when - fields order/], end_tag => 1 ); - } + fields order/], + ); # # Procedures # - for my $foo ( $schema->get_procedures ) { - xml_obj($xml, $foo, tag => "procedure", - methods => [qw/name sql parameters owner comments order/], end_tag=>1 ); - } + xml_obj_children( $xml, $schema, + tag => 'procedure', + methods => [qw/name sql parameters owner comments order/], + ); $xml->endTag([ $Namespace => 'schema' ]); $xml->end; @@ -303,11 +292,40 @@ sub produce { return $io; } -# ------------------------------------------------------------------- + +# +# Takes and XML::Write object, Schema::* parent object, the tag name, +# the collection name and a list of methods (of the children) to write as XML. +# The collection name defaults to the name with an s on the end and is used to +# work out the method to get the children with. eg a name of 'foo' gives a +# collection of foos and gets the members using ->get_foos. +# +sub xml_obj_children { + my ($xml,$parent) = (shift,shift); + my %args = @_; + my ($name,$collection_name,$methods) + = @args{qw/tag collection_tag methods/}; + $collection_name ||= "${name}s"; + my $meth = "get_$collection_name"; + + my @kids = $parent->$meth; + #@kids || return; + $xml->startTag( [ $Namespace => $collection_name ] ); + for my $obj ( @kids ) { + xml_obj($xml, $obj, + tag => "$name", + end_tag => 1, + methods => $methods, + ); + } + $xml->endTag( [ $Namespace => $collection_name ] ); +} + # # Takes an XML::Writer, 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. +# except for the methods listed in @MAP_AS_ELEMENTS which get written as child +# data elements. # # The attributes/tags are written in the same order as the method names are # passed. diff --git a/t/17sqlfxml-producer.t b/t/17sqlfxml-producer.t index 3f39727..091bee1 100644 --- a/t/17sqlfxml-producer.t +++ b/t/17sqlfxml-producer.t @@ -30,7 +30,7 @@ local $SIG{__WARN__} = sub { #============================================================================= BEGIN { - maybe_plan(15, + maybe_plan(14, 'XML::Writer', 'Test::Differences', 'SQL::Translator::Producer::XML::SQLFairy'); @@ -48,33 +48,38 @@ my ($obj,$ans,$xml); $ans = < - - - - - comment on id field - - - - - - - - - - - - - - - - - - - - - -
+ + + + + + comment on id field + + + + + + + + + + + + + + + + + + + + + +
+ + + + EOXML @@ -86,7 +91,7 @@ $obj = SQL::Translator->new( from => "MySQL", to => "XML-SQLFairy", ); -lives_ok {$xml = $obj->translate($file);} "Translate (attrib_values=>1) ran"; +$xml = $obj->translate($file) or die $obj->error; ok("$xml" ne "" ,"Produced something!"); print "XML:\n$xml" if DEBUG; # Strip sqlf header with its variable date so we diff safely @@ -104,9 +109,14 @@ my ($obj,$ans,$xml); $ans = < - - select name, age from person - + + + + select name, age from person + + + + EOXML @@ -148,9 +158,14 @@ my ($obj,$ans,$xml); $ans = < - - update modified=timestamp(); - + + + + + update modified=timestamp(); + + + EOXML @@ -195,10 +210,15 @@ my ($obj,$ans,$xml); $ans = < - - select foo from bar - Go Sox! - + + + + + + select foo from bar + Go Sox! + + EOXML @@ -242,16 +262,21 @@ my ($obj,$ans,$xml); $ans = < - - - - - - - - - -
+ + + + + + + + + + +
+ + + + EOXML diff --git a/t/data/xml/schema.xml b/t/data/xml/schema.xml index aec20ff..3750076 100644 --- a/t/data/xml/schema.xml +++ b/t/data/xml/schema.xml @@ -6,59 +6,67 @@ Created on Fri Aug 15 15:08:18 2003 --> - - - - - - - - - - - - - - Hello emptytagdef - - + +
+ + + + + + + + + + + + + Hello emptytagdef + + - - - + + + - - - - -
+ + + + + + - - SELECT email FROM Basic WHERE email IS NOT NULL - + + + SELECT email FROM Basic WHERE email IS NOT NULL + + - - update modified=timestamp(); - + + + update modified=timestamp(); + + - - select foo from bar - Go Sox! - + + + select foo from bar + Go Sox! + +