X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F16xml-parser.t;h=a863ba4ec733a35e58dc6076fbdf92a75219c385;hb=1c375f480a1472ac584677277d2049e674bcbd1e;hp=dab4d927b13751b1dbc542835efcd2b770d5c07f;hpb=9bbbf403746a9dbd316161644f665e055eaf27c1;p=dbsrgits%2FSQL-Translator.git diff --git a/t/16xml-parser.t b/t/16xml-parser.t index dab4d92..a863ba4 100644 --- a/t/16xml-parser.t +++ b/t/16xml-parser.t @@ -3,75 +3,30 @@ # 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; # +# Run script with -d for debug. use strict; + +use FindBin qw/$Bin/; + use Test::More; +use Test::SQL::Translator; use Test::Exception; - -use strict; use Data::Dumper; +use SQL::Translator; +use SQL::Translator::Schema::Constants; + +# Simple options. -d for debug my %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 -#============================================================================= - -my %ATTRIBUTES; -$ATTRIBUTES{field} = [qw/ -name -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"; - } - } -} - -# TODO test_constraint, test_index # Testing 1,2,3,4... #============================================================================= -plan tests => 198; - -use SQL::Translator; -use SQL::Translator::Schema::Constants; +plan tests => 274; foreach ( "$Bin/data/xml/schema-basic.xml", @@ -96,7 +51,6 @@ sub do_file { filename => $testschema, ); print $sql if DEBUG; - #print "Debug:", Dumper($obj) if DEBUG; # Test the schema objs generted from the XML # @@ -109,121 +63,109 @@ sub do_file { 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"; + table_ok( $scma->get_table("Basic"), { + name => "Basic", + fields => [ + { + name => "id", + data_type => "int", + default_value => undef, + is_nullable => 0, + size => 10, + is_primary_key => 1, + is_auto_increment => 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, + }, + { + 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, + }, + ], + constraints => [ + { + type => PRIMARY_KEY, + fields => ["id"], + }, + { + name => 'emailuniqueindex', + type => UNIQUE, + fields => ["email"], + } + ], + indices => [ + { + name => "titleindex", + fields => ["title"], + }, + ], + }); # # View - # + # my @views = $scma->get_views; - is( scalar @views, 1, 'Number of views is 1' ); - my $v = $views[0]; - isa_ok( $v, 'SQL::Translator::Schema::View', 'View' ); - is( $v->name, 'email_list', "View's Name is 'email_list'" ); - is( $v->sql, "SELECT email FROM Basic WHERE email IS NOT NULL", - "View's sql" ); - is( join(",",$v->fields), 'email', "View's Fields" ); + view_ok( $views[0], { + name => 'email_list', + sql => "SELECT email FROM Basic WHERE email IS NOT NULL", + fields => ['email'], + }); + + my @triggs = $scma->get_triggers; + trigger_ok( $triggs[0], { + name => 'foo_trigger', + perform_action_when => 'after', + database_event => 'insert', + on_table => 'foo', + action => 'update modified=timestamp();', + }); + - # - # Trigger - # - { - my $name = 'foo_trigger'; - my $perform_action_when = 'after'; - my $database_event = 'insert'; - my $on_table = 'foo'; - my $action = 'update modified=timestamp();'; - my @triggs = $scma->get_triggers; - is( scalar @triggs, 1, 'Number of triggers is 1' ); - my $t = $triggs[0]; - isa_ok( $t, 'SQL::Translator::Schema::Trigger', 'Trigger' ); - is( $t->name, $name, qq[Name is "$name"] ); - is( $t->perform_action_when, $perform_action_when, - qq[Perform action when is "$perform_action_when"] ); - is( $t->database_event, $database_event, - qq[Database event is "$database_event"] ); - is( $t->on_table, $on_table, qq[Table is "$on_table"] ); - is( $t->action, $action, qq[Action is "$action"] ); - } - # # Procedure # - { - my $name = 'foo_proc'; - my $sql = 'select foo from bar'; - my $parameters = 'foo, bar'; - my $owner = 'Nomar'; - my $comments = 'Go Sox!'; - my @procs = $scma->get_procedures; - is( scalar @procs, 1, 'Number of procedures is 1' ); - my $p = $procs[0]; - isa_ok( $p, 'SQL::Translator::Schema::Procedure', 'Procedure' ); - is( $p->name, $name, qq[Name is "$name"] ); - is( $p->sql, $sql, qq[SQL is "$sql"] ); - is( join(',', $p->parameters), 'foo,bar', qq[Params = 'foo,bar'] ); - is( $p->comments, $comments, qq[Comments = "$comments"] ); - } + my @procs = $scma->get_procedures; + procedure_ok( $procs[0], { + name => 'foo_proc', + sql => 'select foo from bar', + parameters => ['foo', 'bar'], + owner => 'Nomar', + comments => 'Go Sox!', + }); + print "Debug:", Dumper($obj) if DEBUG; } # /Test of schema