X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FTest%2FSQL%2FTranslator.pm;h=79f412bb20df82facbfcca374f6f7646c17b8333;hb=ba506e52c480afe33dfec6b38a12759fad1e7fa2;hp=7a9a47528717481d638d17ae4f2bec7051b5685c;hpb=b178940934ec79968ed16511ec2644f3736c92f2;p=dbsrgits%2FSQL-Translator.git diff --git a/lib/Test/SQL/Translator.pm b/lib/Test/SQL/Translator.pm index 7a9a475..79f412b 100644 --- a/lib/Test/SQL/Translator.pm +++ b/lib/Test/SQL/Translator.pm @@ -1,8 +1,6 @@ package Test::SQL::Translator; # ---------------------------------------------------------------------- -# $Id: Translator.pm,v 1.7 2004-11-05 15:03:10 grommit Exp $ -# ---------------------------------------------------------------------- # Copyright (C) 2003 The SQLFairy Authors # # This program is free software; you can redistribute it and/or @@ -30,11 +28,12 @@ Test::SQL::Translator - Test::More test functions for the Schema objects. use strict; use warnings; +use Test::More; +use SQL::Translator::Schema::Constants; use base qw(Exporter); - use vars qw($VERSION @EXPORT @EXPORT_OK); -$VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; +$VERSION = '1.60'; @EXPORT = qw( schema_ok table_ok @@ -47,109 +46,114 @@ $VERSION = sprintf "%d.%02d", q$Revision: 1.7 $ =~ /(\d+)\.(\d+)/; maybe_plan ); -use Test::More; -use SQL::Translator::Schema::Constants; - # $ATTRIBUTES{ } = { => , ... } -my %ATTRIBUTES; -$ATTRIBUTES{field} = { - name => undef, - data_type => '', - default_value => undef, - size => '0', - is_primary_key => 0, - is_unique => 0, - is_nullable => 1, - is_foreign_key => 0, - is_auto_increment => 0, - comments => '', - extra => {}, - # foreign_key_reference, - is_valid => 1, - # order -}; -$ATTRIBUTES{constraint} = { - name => '', - type => '', - deferrable => 1, - expression => '', - is_valid => 1, - fields => [], - match_type => '', - options => [], - on_delete => '', - on_update => '', - reference_fields => [], - reference_table => '', - extra => {}, -}; -$ATTRIBUTES{'index'} = { - fields => [], - is_valid => 1, - name => "", - options => [], - type => NORMAL, - extra => {}, -}; -$ATTRIBUTES{'view'} = { - name => "", - sql => "", - fields => [], - is_valid => 1, - extra => {}, -}; -$ATTRIBUTES{'trigger'} = { - name => '', - perform_action_when => undef, - database_event => undef, - on_table => undef, - action => undef, - is_valid => 1, - extra => {}, -}; -$ATTRIBUTES{'procedure'} = { - name => '', - sql => '', - parameters => [], - owner => '', - comments => '', - extra => {}, -}; -$ATTRIBUTES{table} = { - comments => undef, - name => '', - #primary_key => undef, # pkey constraint - options => [], - #order => 0, - fields => undef, - constraints => undef, - indices => undef, - is_valid => 1, - extra => {}, -}; -$ATTRIBUTES{schema} = { - name => '', - database => '', - procedures => undef, # [] when set - tables => undef, # [] when set - triggers => undef, # [] when set - views => undef, # [] when set - is_valid => 1, - extra => {}, -}; - - +my %ATTRIBUTES = ( + field => { + name => undef, + data_type => '', + default_value => undef, + size => '0', + is_primary_key => 0, + is_unique => 0, + is_nullable => 1, + is_foreign_key => 0, + is_auto_increment => 0, + comments => '', + extra => {}, + # foreign_key_reference, + is_valid => 1, + # order + }, + constraint => { + name => '', + type => '', + deferrable => 1, + expression => '', + is_valid => 1, + fields => [], + match_type => '', + options => [], + on_delete => '', + on_update => '', + reference_fields => [], + reference_table => '', + extra => {}, + }, + index => { + fields => [], + is_valid => 1, + name => "", + options => [], + type => NORMAL, + extra => {}, + }, + view => { + name => "", + sql => "", + fields => [], + is_valid => 1, + extra => {}, + }, + trigger => { + name => '', + perform_action_when => undef, + database_events => undef, + on_table => undef, + action => undef, + is_valid => 1, + extra => {}, + }, + procedure => { + name => '', + sql => '', + parameters => [], + owner => '', + comments => '', + extra => {}, + }, + table => { + comments => undef, + name => '', + #primary_key => undef, # pkey constraint + options => [], + #order => 0, + fields => undef, + constraints => undef, + indices => undef, + is_valid => 1, + extra => {}, + }, + schema => { + name => '', + database => '', + procedures => undef, # [] when set + tables => undef, # [] when set + triggers => undef, # [] when set + views => undef, # [] when set + is_valid => 1, + extra => {}, + } +); # Given a test hash and schema object name set any attribute keys not present in # the test hash to their default value for that schema object type. # e.g. default_attribs( $test, "field" ); sub default_attribs { - my ($foo, $what) = @_; - die "Can't add default attibs - unkown Scheam object type '$what'." - unless exists $ATTRIBUTES{$what}; - $foo->{$_} = $ATTRIBUTES{$what}{$_} - foreach grep !exists($foo->{$_}), keys %{$ATTRIBUTES{$what}}; - return $foo; + my ($hashref, $object_type) = @_; + + if ( !exists $ATTRIBUTES{ $object_type } ) { + die "Can't add default attribs for unknown Schema " + . "object type '$object_type'."; + } + + for my $attr ( + grep { !exists $hashref->{ $_ } } + keys %{ $ATTRIBUTES{ $object_type } } + ) { + $hashref->{ $attr } = $ATTRIBUTES{ $object_type }{ $attr } + } + + return $hashref; } # Format test name so it will prepend the test names used below. @@ -280,7 +284,7 @@ sub trigger_ok { my $t_name = t_name($name); default_attribs($test,"index"); - is( $obj->name, $test->{name}, "${t_name}Constraint '$test->{name}'" ); + is( $obj->name, $test->{name}, "${t_name}Trigger '$test->{name}'" ); is( $obj->is_valid, $test->{is_valid}, "$t_name is ".($test->{is_valid} ? '' : 'not ').'valid' ); @@ -288,8 +292,12 @@ sub trigger_ok { is( $obj->perform_action_when, $test->{perform_action_when}, "$t_name perform_action_when is '$test->{perform_action_when}'" ); - is( $obj->database_event, $test->{database_event}, - "$t_name database_event is '$test->{database_event}'" ); + is( join(',', $obj->database_events), $test->{database_events}, + sprintf("%s database_events is '%s'", + $t_name, + $test->{'database_events'}, + ) + ); is( $obj->on_table, $test->{on_table}, "$t_name on_table is '$test->{on_table}'" ); @@ -337,7 +345,7 @@ sub procedure_ok { "$t_name comments is '$test->{comments}'" ); is( $obj->owner, $test->{owner}, "$t_name owner is '$test->{owner}'" ); - + is_deeply( { $obj->extra }, $test->{extra}, "$t_name extra" ); } @@ -376,30 +384,34 @@ sub table_ok { # Constraints and Indices _test_kids($obj, $test, $name, { - constraint => "constraints", - 'index' => "indices", + constraint => 'constraints', + index => 'indices', }); } sub _test_kids { - my ($obj, $test, $name, $kids) = @_; - my $t_name = t_name($name); + my ( $obj, $test, $name, $kids ) = @_; + my $t_name = t_name($name); my $obj_name = ref $obj; ($obj_name) = $obj_name =~ m/^.*::(.*)$/; - while ( my($foo,$plural) = each %$kids ) { - next unless defined $test->{$plural}; - if ( my @tfoo = @{$test->{$plural}} ) { + while ( my ( $object_type, $plural ) = each %$kids ) { + next unless defined $test->{ $plural }; + + if ( my @tests = @{ $test->{ $plural } } ) { my $meth = "get_$plural"; - my @foo = $obj->$meth; - is(scalar(@foo), scalar(@tfoo), - "${t_name}$obj_name has ".scalar(@tfoo)." $plural"); - foreach ( @foo ) { - my $ans = { lc($obj_name) => $obj->name, %{shift @tfoo}}; - #my $ans = shift @tfoo; - my $meth = "${foo}_ok"; - { no strict 'refs'; - $meth->( $_, $ans, $name ); + my @objects = $obj->$meth; + is( scalar(@objects), scalar(@tests), + "${t_name}$obj_name has " . scalar(@tests) . " $plural" + ); + + for my $object (@objects) { + my $ans = { lc($obj_name) => $obj->name, %{ shift @tests } }; + + my $meth = "${object_type}_ok"; + { + no strict 'refs'; + $meth->( $object, $ans, $name ); } } } @@ -438,9 +450,9 @@ sub schema_ok { # Procedures, Triggers, Views _test_kids($obj, $test, $name, { - procedure => "procedures", - trigger => "triggers", - view => "views", + procedure => 'procedures', + trigger => 'triggers', + view => 'views', }); } @@ -468,9 +480,12 @@ sub maybe_plan { join ", ", @errors; plan skip_all => $msg; } - else { + elsif ($ntests and $ntests ne 'no_plan') { plan tests => $ntests; } + else { + plan 'no_plan'; + } } 1; # compile please =========================================================== @@ -616,10 +631,11 @@ schema file and test yaml file to compare it against. =head1 AUTHOR -Mark D. Addison Emark.addison@itn.co.ukE, Darren Chamberlain . +Mark D. Addison Emark.addison@itn.co.ukE, +Darren Chamberlain . -Thanks to Ken Y. Clark for the original table and field test code taken from -his mysql test. +Thanks to Ken YouensClark for the original table and field test code taken +from his mysql test. =head1 SEE ALSO