X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F16xml-parser.t;h=49c0a26cef1fbb187b325097f1519d3fbdcce737;hb=5a0c7b434ab26721269fb21199e93568cf17bd83;hp=be7372aa4f1d2f3e3e3bb77340bfc7a647a8ce85;hpb=5ff70f1ac9dd66a8fec633b4ec71fa6a395fa210;p=dbsrgits%2FSQL-Translator.git diff --git a/t/16xml-parser.t b/t/16xml-parser.t index be7372a..49c0a26 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -3,163 +3,194 @@ # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl test.pl' - -# -# basic.t -# ------- -# Tests that; # - -use Test::More tests => 78; -use Test::Exception; +# Run script with -d for debug. use strict; -use Data::Dumper; -our %opt; -BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } -use constant DEBUG => (exists $opt{d} ? 1 : 0); -local $SIG{__WARN__} = sub { diag "[warn] ", @_; }; use FindBin qw/$Bin/; -# Usefull test subs for the schema objs -#============================================================================= +use Test::More; +use Test::SQL::Translator; +use Test::Exception; +use Data::Dumper; +use SQL::Translator; +use SQL::Translator::Schema::Constants; -our %ATTRIBUTES; -$ATTRIBUTES{field} = [qw/ -name -order -data_type -default_value -size -is_primary_key -is_unique -is_nullable -is_foreign_key -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 ( 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"; - } - } -} +# Simple options. -d for debug +my %opt; +BEGIN { map { $opt{$_}=1 if s/^-// } @ARGV; } +use constant DEBUG => (exists $opt{d} ? 1 : 0); -# TODO test_constraint, test_index # Testing 1,2,3,4... #============================================================================= -use SQL::Translator; -use SQL::Translator::Schema::Constants; +BEGIN { + maybe_plan(150, 'SQL::Translator::Parser::XML::SQLFairy'); +} -# Parse the test XML schema -our $obj; -$obj = SQL::Translator->new( +my $testschema = "$Bin/data/xml/schema.xml"; + +my $sqlt; +$sqlt = 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", +my $sql = $sqlt->translate( + from => 'XML-SQLFairy', + to => 'MySQL', filename => $testschema, -); +) or die $sqlt->error; 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/] , - "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, -}); - -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"; +my $scma = $sqlt->schema; + +# Hmmm, when using schema_ok the field test data gets a bit too nested and +# fiddly to work with. (See 28xml-xmi-parser-sqlfairy.t for more a split out +# version) +schema_ok( $scma, { + tables => [ + { + name => "Basic", + extra => { + foo => "bar", + hello => "world", + bar => "baz", + mysql_table_type => "InnoDB", + }, + fields => [ + { + name => "id", + data_type => "int", + default_value => undef, + is_nullable => 0, + size => 10, + is_primary_key => 1, + is_auto_increment => 1, + extra => { ZEROFILL => 1 }, + }, + { + name => "title", + data_type => "varchar", + is_nullable => 0, + default_value => "hello", + size => 100, + }, + { + name => "description", + data_type => "text", + is_nullable => 1, + default_value => "", + }, + { + name => "email", + data_type => "varchar", + size => 255, + is_unique => 1, + default_value => undef, + is_nullable => 1, + extra => { + foo => "bar", + hello => "world", + bar => "baz", + } + }, + { + name => "explicitnulldef", + data_type => "varchar", + default_value => undef, + is_nullable => 1, + }, + { + name => "explicitemptystring", + data_type => "varchar", + default_value => "", + is_nullable => 1, + }, + { + name => "emptytagdef", + data_type => "varchar", + default_value => "", + is_nullable => 1, + comments => "Hello emptytagdef", + }, + ], + constraints => [ + { + type => PRIMARY_KEY, + fields => ["id"], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, + }, + { + name => 'emailuniqueindex', + type => UNIQUE, + fields => ["email"], + } + ], + indices => [ + { + name => "titleindex", + fields => ["title"], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, + }, + ], + } # end table Basic + ], # end tables + + views => [ + { + name => 'email_list', + sql => "SELECT email FROM Basic WHERE email IS NOT NULL", + fields => ['email'], + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, + }, + ], + + triggers => [ + { + name => 'foo_trigger', + perform_action_when => 'after', + database_event => 'insert', + on_table => 'foo', + action => 'update modified=timestamp();', + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, + }, + ], + + procedures => [ + { + name => 'foo_proc', + sql => 'select foo from bar', + parameters => ['foo', 'bar'], + owner => 'Nomar', + comments => 'Go Sox!', + extra => { + foo => "bar", + hello => "world", + bar => "baz", + }, + }, + ], + +}); # end schema