From: Mark Addison Date: Wed, 6 Aug 2003 22:08:16 +0000 (+0000) Subject: Fixed default value bug in Parser::SqlfXML. X-Git-Tag: v0.04~355 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=5ff70f1ac9dd66a8fec633b4ec71fa6a395fa210;p=dbsrgits%2FSQL-Translator.git Fixed default value bug in Parser::SqlfXML. --- diff --git a/lib/SQL/Translator/Parser/SqlfXML.pm b/lib/SQL/Translator/Parser/SqlfXML.pm index 6919b3a..4ec8df5 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.1 2003-08-06 17:14:08 grommit Exp $ +# $Id: SqlfXML.pm,v 1.2 2003-08-06 22:08:16 grommit Exp $ # ------------------------------------------------------------------- # Copyright (C) 2003 Mark Addison , # @@ -49,13 +49,23 @@ To see and example of the XML translate one of your schema :) e.g. $ sql_translator.pl --from MySQL --to SqftXML foo_schema.sql +==head1 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). + + + EMPTY_STRING + NULL + =cut use strict; use warnings; use vars qw[ $DEBUG $VERSION @EXPORT_OK ]; -$VERSION = sprintf "%d.%02d", q$Revision: 1.1 $ =~ /(\d+)\.(\d+)/; +$VERSION = sprintf "%d.%02d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/; $DEBUG = 0 unless defined $DEBUG; use Data::Dumper; @@ -103,6 +113,14 @@ sub parse { my %fdata = get_tagfields($xp, $_, "sqlf:", qw/name data_type size default_value is_nullable is_auto_increment is_primary_key is_foreign_key comments/); + if (exists $fdata{default_value} and defined $fdata{default_value}){ + if ( $fdata{default_value} =~ /^\s*NULL\s*$/ ) { + $fdata{default_value}= undef; + } + elsif ( $fdata{default_value} =~ /^\s*EMPTY_STRING\s*$/ ) { + $fdata{default_value} = ""; + } + } my $field = $table->add_field(%fdata) or die $schema->error; $table->primary_key($field->name) if $fdata{'is_primary_key'}; # TODO We should be able to make the table obj spot this when we @@ -136,12 +154,18 @@ sub parse { # get_tagfields XPNODE, NAMESPACE => qw/TAGNAMES/; # get_tagfields $node, "sqlf:" => qw/name type fields reference/; +# +# Returns hash of data. If a tag isn't in the file it is not in this +# hash. +# TODO Add handling of and explicit NULL value. sub get_tagfields { my ($xp, $node, @names) = @_; my (%data, $ns); foreach (@names) { if ( m/:$/ ) { $ns = $_; next; } # Set def namespace - $data{$_} = "".$xp->findvalue( (s/(^.*?:)// ? $1 : $ns).$_, $node ); + my $path = (s/(^.*?:)// ? $1 : $ns).$_; + $data{$_} = $xp->findvalue($path,$node) if $xp->exists($path,$node); + debug "Got $_=".(defined $data{$_} ? $data{$_} : "UNDEF"); } return wantarray ? %data : \%data; } @@ -156,7 +180,7 @@ __END__ * Support sqf:options. * Test forign keys are parsed ok. - * Control over defaulting and parsing of empty vs non-existant tags. + * Control over defaulting of non-existant tags. =head1 AUTHOR diff --git a/t/16xml-parser.t b/t/16xml-parser.t index f5209b2..be7372a 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -10,7 +10,7 @@ # Tests that; # -use Test::More qw/no_plan/; +use Test::More tests => 78; use Test::Exception; use strict; @@ -40,24 +40,27 @@ is_auto_increment /]; sub test_field { - my ($fld,$test) = @_; - die "test_field needs a least a name!" unless $test->{name}; - my $name = $test->{name}; - is $fld->name, $name, "$name - Name right"; - - foreach my $attr ( @{$ATTRIBUTES{field}} ) { - if ( defined(my $ans = $test->{$attr}) ) { - if ( $attr =~ m/^is_/ ) { - ok $fld->$attr, " $name - $attr true"; - } - else { - is $fld->$attr, $ans, " $name - $attr = '$ans'"; - } - } - else { - ok !$fld->$attr, "$name - $attr not set"; - } - } + my ($fld,$test) = @_; + die "test_field needs a least a name!" unless $test->{name}; + my $name = $test->{name}; + is $fld->name, $name, "$name - Name right"; + + foreach my $attr ( @{$ATTRIBUTES{field}} ) { + if ( exists $test->{$attr} ) { + my $ans = $test->{$attr}; + if ( $attr =~ m/^is_/ ) { + if ($ans) { ok $fld->$attr, " $name - $attr true"; } + else { ok !$fld->$attr, " $name - $attr false"; } + } + else { + is $fld->$attr, $ans, " $name - $attr = '" + .(defined $ans ? $ans : "NULL" )."'"; + } + } + else { + ok !$fld->$attr, "$name - $attr not set"; + } + } } # TODO test_constraint, test_index @@ -71,18 +74,18 @@ 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, + 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, + from => "SqlfXML", + to =>"MySQL", + filename => $testschema, ); -print $sql; +print $sql if DEBUG; #print "Debug:", Dumper($obj) if DEBUG; # Test the schema objs generted from the XML @@ -94,35 +97,56 @@ 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/] - , "Table Basic's fields"); +is_deeply( [map {$_->name} $tbl->get_fields], + [qw/id title description email explicitnulldef explicitemptystring/] , + "Table Basic's fields"); test_field($tbl->get_field("id"),{ - name => "id", - order => 1, - data_type => "int", - size => 10, - is_primary_key => 1, - is_auto_increment => 1, + 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", - default_value => "hello", - size => 100, + 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, + 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, + 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, }); my @indices = $tbl->get_indices; diff --git a/t/data/xml/schema-basic.xml b/t/data/xml/schema-basic.xml index cd7bf3c..949d1bf 100644 --- a/t/data/xml/schema-basic.xml +++ b/t/data/xml/schema-basic.xml @@ -6,7 +6,7 @@ Created on Fri Aug 1 11:24:58 2003 --> - + Basic 1 @@ -16,6 +16,7 @@ Created on Fri Aug 1 11:24:58 2003 1 1 int + 0 10 1 @@ -24,31 +25,47 @@ Created on Fri Aug 1 11:24:58 2003 varchar 100 hello + 0 2 - description + description text - 1 + 3 - email + email varchar - 255 + 1 + 255 4 - - - + + explicitnulldef + varchar + 1 + NULL + 5 + + + explicitemptystring + varchar + 1 + EMPTY_STRING + 5 + + + + - title + title titleindex NORMAL - - + + 1 email