From: Mark Addison Date: Fri, 15 Aug 2003 15:08:08 +0000 (+0000) Subject: Added support for the attrib_values option of the XML producer. X-Git-Tag: v0.04~331 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=07a82527afec7423abff957ec1a67e9901be20b8;p=dbsrgits%2FSQL-Translator.git Added support for the attrib_values option of the XML producer. --- diff --git a/lib/SQL/Translator/Parser/SqlfXML.pm b/lib/SQL/Translator/Parser/SqlfXML.pm index e1d3637..9d25cf7 100644 --- a/lib/SQL/Translator/Parser/SqlfXML.pm +++ b/lib/SQL/Translator/Parser/SqlfXML.pm @@ -1,7 +1,7 @@ package SQL::Translator::Parser::SqlfXML; # ------------------------------------------------------------------- -# $Id: SqlfXML.pm,v 1.4 2003-08-07 15:03:30 grommit Exp $ +# $Id: SqlfXML.pm,v 1.5 2003-08-15 15:08:08 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -45,29 +45,45 @@ SQL::Translator::Producer::SqlfXML. A SQL Translator parser to parse the XML files produced by its SqftXML producer. The XML must be in the namespace http://sqlfairy.sourceforge.net/sqlfairy.xml. -To see and example of the XML translate one of your schema :) e.g. +To see an example of the XML translate one of your schema :) e.g. - $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql + $ sql_translator.pl --from=MySQL --to=SqftXML foo_schema.sql -==head1 default_value +==head2 attrib_values + +The parser will happily parse XML produced with the attrib_values arg set. If +it sees a value set as an attribute and a tag, the tag value will override +that of the attribute. + +e.g. For the xml below the table would get the name 'bar'. + + + foo + + +==head2 default_value Leave the tag out all together to use the default in Schema::Field. Use empty -tags or EMPTY_STRING for a zero lenth string. NULL for an explicit null -(currently sets default_value to undef Schema::Field). +tags or EMPTY_STRING for a zero lenth string. NULL for an explicit null +(currently sets default_value to undef in the Schema::Field obj). EMPTY_STRING NULL - + - + +==head2 ARGS + +Doesn't take any extra parser args at the moment. + =cut use strict; use warnings; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.4 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.5 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -109,8 +125,8 @@ sub parse { # my @nodes = $xp->findnodes('sqlf:fields/sqlf:field',$tblnode); foreach ( - sort { "".$xp->findvalue('sqlf:order',$a) - <=> "".$xp->findvalue('sqlf:order',$b) } @nodes + sort { ("".$xp->findvalue('sqlf:order',$a) || 0) + <=> ("".$xp->findvalue('sqlf:order',$b) || 0) } @nodes ) { my %fdata = get_tagfields($xp, $_, "sqlf:", qw/name data_type size default_value is_nullable is_auto_increment @@ -165,9 +181,11 @@ sub get_tagfields { my (%data, $ns); foreach (@names) { if ( m/:$/ ) { $ns = $_; next; } # Set def namespace - my $path = (s/(^.*?:)// ? $1 : $ns).$_; - $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node); - debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF"); + my $thisns = (s/(^.*?:)// ? $1 : $ns); + foreach my $path ( "\@$thisns$_","$thisns$_") { + $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node); + debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF"); + } } return wantarray ? %data : \%data; } @@ -181,8 +199,8 @@ __END__ =head1 BUGS B e.g. Will be parsed as "" and hence also -false. This is a bit counter intuative for some tags as seeing - you might think that it was set when it fact it wouldn't +false. This is a bit counter intuative for some tags as seeing + you might think that it was set when it fact it wouldn't be. So for now it is safest not to use them until their handling by the parser is defined. @@ -190,7 +208,7 @@ is defined. * Support sqf:options. * Test forign keys are parsed ok. - * Sort out sane handling of empty tags vs tags with no content + * Sort out sane handling of empty tags vs tags with no content vs it no tag being there. * Control over defaulting of non-existant tags. diff --git a/t/16xml-parser.t b/t/16xml-parser.t index cf861f9..b9fa08f 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -28,7 +28,6 @@ use FindBin qw/$Bin/; our %ATTRIBUTES; $ATTRIBUTES{field} = [qw/ name -order data_type default_value size @@ -68,107 +67,108 @@ sub test_field { # Testing 1,2,3,4... #============================================================================= -plan tests => 89; +plan tests => 162; use SQL::Translator; use SQL::Translator::Schema::Constants; -# Parse the test XML schema -our $obj; -$obj = SQL::Translator->new( - debug => DEBUG, - show_warnings => 1, - add_drop_table => 1, -); -my $testschema = "$Bin/data/xml/schema-basic.xml"; -die "Can't find test schema $testschema" unless -e $testschema; -my $sql = $obj->translate( - from => "SqlfXML", - to =>"MySQL", - filename => $testschema, -); -print $sql if DEBUG; -#print "Debug:", Dumper($obj) if DEBUG; - -# Test the schema objs generted from the XML -# -my $scma = $obj->schema; -my @tblnames = map {$_->name} $scma->get_tables; -is_deeply( \@tblnames, [qw/Basic/], "tables"); - -# Basic -my $tbl = $scma->get_table("Basic"); -is $tbl->order, 1, "Basic->order"; -is_deeply( [map {$_->name} $tbl->get_fields], [qw/ - id title description email explicitnulldef explicitemptystring emptytagdef -/] , "Table Basic's fields"); -test_field($tbl->get_field("id"),{ - name => "id", - order => 1, - data_type => "int", - default_value => undef, - is_nullable => 0, - size => 10, - is_primary_key => 1, - is_auto_increment => 1, -}); -test_field($tbl->get_field("title"),{ - name => "title", - order => 2, - data_type => "varchar", - is_nullable => 0, - default_value => "hello", - size => 100, -}); -test_field($tbl->get_field("description"),{ - name => "description", - order => 3, - data_type => "text", - is_nullable => 1, - default_value => "", -}); -test_field($tbl->get_field("email"),{ - name => "email", - order => 4, - data_type => "varchar", - size => 255, - is_unique => 1, - default_value => undef, - is_nullable => 1, -}); -test_field($tbl->get_field("explicitnulldef"),{ - name => "explicitnulldef", - order => 5, - data_type => "varchar", - default_value => undef, - is_nullable => 1, -}); -test_field($tbl->get_field("explicitemptystring"),{ - name => "explicitemptystring", - order => 6, - data_type => "varchar", - default_value => "", - is_nullable => 1, -}); -test_field($tbl->get_field("emptytagdef"),{ - name => "emptytagdef", - order => 7, - data_type => "varchar", - default_value => "", - is_nullable => 1, -}); - -my @indices = $tbl->get_indices; -is scalar(@indices), 1, "Table basic has 1 index"; - -my @constraints = $tbl->get_constraints; -is scalar(@constraints), 2, "Table basic has 2 constraints"; -my $con = shift @constraints; -is $con->table, $tbl, "Constaints table right"; -is $con->name, "", "Constaints table right"; -is $con->type, PRIMARY_KEY, "Constaint is primary key"; -is_deeply [$con->fields], ["id"], "Constaint fields"; -$con = shift @constraints; -is $con->table, $tbl, "Constaints table right"; -is $con->type, UNIQUE, "Constaint UNIQUE"; -is_deeply [$con->fields], ["email"], "Constaint fields"; +foreach ( + "$Bin/data/xml/schema-basic.xml", + "$Bin/data/xml/schema-basic-attribs.xml" +) { + do_file($_); +} + +sub do_file { + my $testschema = shift; + # Parse the test XML schema + our $obj; + $obj = SQL::Translator->new( + debug => DEBUG, + show_warnings => 1, + add_drop_table => 1, + ); + die "Can't find test schema $testschema" unless -e $testschema; + my $sql = $obj->translate( + from => "SqlfXML", + to =>"MySQL", + filename => $testschema, + ); + print $sql if DEBUG; + #print "Debug:", Dumper($obj) if DEBUG; + + # Test the schema objs generted from the XML + # + my $scma = $obj->schema; + my @tblnames = map {$_->name} $scma->get_tables; + is_deeply( \@tblnames, [qw/Basic/], "tables"); + + # Basic + my $tbl = $scma->get_table("Basic"); + is_deeply( [map {$_->name} $tbl->get_fields], [qw/ + id title description email explicitnulldef explicitemptystring emptytagdef + /] , "Table Basic's fields"); + test_field($tbl->get_field("id"),{ + name => "id", + data_type => "int", + default_value => undef, + is_nullable => 0, + size => 10, + is_primary_key => 1, + is_auto_increment => 1, + }); + test_field($tbl->get_field("title"),{ + name => "title", + data_type => "varchar", + is_nullable => 0, + default_value => "hello", + size => 100, + }); + test_field($tbl->get_field("description"),{ + name => "description", + data_type => "text", + is_nullable => 1, + default_value => "", + }); + test_field($tbl->get_field("email"),{ + name => "email", + data_type => "varchar", + size => 255, + is_unique => 1, + default_value => undef, + is_nullable => 1, + }); + test_field($tbl->get_field("explicitnulldef"),{ + name => "explicitnulldef", + data_type => "varchar", + default_value => undef, + is_nullable => 1, + }); + test_field($tbl->get_field("explicitemptystring"),{ + name => "explicitemptystring", + data_type => "varchar", + default_value => "", + is_nullable => 1, + }); + test_field($tbl->get_field("emptytagdef"),{ + name => "emptytagdef", + data_type => "varchar", + default_value => "", + is_nullable => 1, + }); + + my @indices = $tbl->get_indices; + is scalar(@indices), 1, "Table basic has 1 index"; + + my @constraints = $tbl->get_constraints; + is scalar(@constraints), 2, "Table basic has 2 constraints"; + my $con = shift @constraints; + is $con->table, $tbl, "Constaints table right"; + is $con->name, "", "Constaints table right"; + is $con->type, PRIMARY_KEY, "Constaint is primary key"; + is_deeply [$con->fields], ["id"], "Constaint fields"; + $con = shift @constraints; + is $con->table, $tbl, "Constaints table right"; + is $con->type, UNIQUE, "Constaint UNIQUE"; + is_deeply [$con->fields], ["email"], "Constaint fields"; +} # /Test of schema diff --git a/t/data/xml/schema-basic-attribs.xml b/t/data/xml/schema-basic-attribs.xml new file mode 100644 index 0000000..dc33687 --- /dev/null +++ b/t/data/xml/schema-basic-attribs.xml @@ -0,0 +1,39 @@ + + + + + + + + + + + + + + + + + + + + + + +