From: Rafael Kitover Date: Tue, 9 Mar 2010 22:44:31 +0000 (-0500) Subject: multi-dsn support for common tests X-Git-Tag: 0.06000~56 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3a89a69f4383e520ddbf4cb2ea22b2e044f7cd96;p=dbsrgits%2FDBIx-Class-Schema-Loader.git multi-dsn support for common tests --- diff --git a/Makefile.PL b/Makefile.PL index ddf257f..0c3ba57 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -30,6 +30,7 @@ requires 'File::Slurp' => '9999.13'; requires 'List::MoreUtils' => 0; requires 'namespace::autoclean' => 0; requires 'Data::Dumper::Concise' => '1.200'; +requires 'Scope::Guard' => 0; install_script 'script/dbicdump'; diff --git a/t/16mssql_common.t b/t/16mssql_common.t index 4282aae..ccce4a4 100644 --- a/t/16mssql_common.t +++ b/t/16mssql_common.t @@ -1,5 +1,7 @@ use strict; use warnings; +use Test::More; +use Test::Exception; # use this if you keep a copy of DBD::Sybase linked to FreeTDS somewhere else BEGIN { @@ -10,25 +12,107 @@ BEGIN { use lib qw(t/lib); use dbixcsl_common_tests; -use dbixcsl_mssql_extra_tests; -my $dsn = $ENV{DBICTEST_MSSQL_DSN} || ''; -my $user = $ENV{DBICTEST_MSSQL_USER} || ''; -my $password = $ENV{DBICTEST_MSSQL_PASS} || ''; +my $dbd_sybase_dsn = $ENV{DBICTEST_MSSQL_DSN} || ''; +my $dbd_sybase_user = $ENV{DBICTEST_MSSQL_USER} || ''; +my $dbd_sybase_password = $ENV{DBICTEST_MSSQL_PASS} || ''; + +my $odbc_dsn = $ENV{DBICTEST_MSSQL_ODBC_DSN} || ''; +my $odbc_user = $ENV{DBICTEST_MSSQL_ODBC_USER} || ''; +my $odbc_password = $ENV{DBICTEST_MSSQL_ODBC_PASS} || ''; my $tester = dbixcsl_common_tests->new( vendor => 'mssql', auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY', default_function => 'getdate()', default_function_def => 'DATETIME DEFAULT getdate()', - dsn => $dsn, - user => $user, - password => $password, - extra => dbixcsl_mssql_extra_tests->extra, + connect_info => [ ($dbd_sybase_dsn ? { + dsn => $dbd_sybase_dsn, + user => $dbd_sybase_user, + password => $dbd_sybase_password, + } : ()), + ($odbc_dsn ? { + dsn => $odbc_dsn, + user => $odbc_user, + password => $odbc_password, + } : ()), + ], + extra => { + create => [ + q{ + CREATE TABLE [mssql_loader_test1.dot] ( + id INT IDENTITY NOT NULL PRIMARY KEY, + dat VARCHAR(8) + ) + }, + q{ + CREATE TABLE mssql_loader_test3 ( + id INT IDENTITY NOT NULL PRIMARY KEY + ) + }, + q{ + CREATE VIEW mssql_loader_test4 AS + SELECT * FROM mssql_loader_test3 + }, + ], + pre_drop_ddl => [ + 'CREATE TABLE mssql_loader_test3 (id INT IDENTITY NOT NULL PRIMARY KEY)', + 'DROP VIEW mssql_loader_test4', + ], + drop => [ + '[mssql_loader_test1.dot]', + 'mssql_loader_test3' + ], + count => 8, + run => sub { + my ($schema, $monikers, $classes) = @_; + +# Test that the table above (with '.' in name) gets loaded correctly. + ok((my $rs = eval { + $schema->resultset($monikers->{'[mssql_loader_test1.dot]'}) }), + 'got a resultset for table with dot in name'); + + ok((my $from = eval { $rs->result_source->from }), + 'got an $rsrc->from for table with dot in name'); + + is ref($from), 'SCALAR', '->table with dot in name is a scalar ref'; + + is eval { $$from }, "[mssql_loader_test1.dot]", + '->table with dot in name has correct name'; + +# Test that identity columns do not have 'identity' in the data_type, and do +# have is_auto_increment. + my $identity_col_info = $schema->resultset($monikers->{loader_test10}) + ->result_source->column_info('id10'); + + is $identity_col_info->{data_type}, 'int', + q{'INT IDENTITY' column has data_type => 'int'}; + + is $identity_col_info->{is_auto_increment}, 1, + q{'INT IDENTITY' column has is_auto_increment => 1}; + +# Test that a bad view (where underlying table is gone) is ignored. + my $dbh = $schema->storage->dbh; + $dbh->do("DROP TABLE mssql_loader_test3"); + + my @warnings; + { + local $SIG{__WARN__} = sub { push @warnings, $_[0] }; + $schema->rescan; + } + ok ((grep /^Bad table or view 'mssql_loader_test4'/, @warnings), + 'bad view ignored'); + + throws_ok { + $schema->resultset($monikers->{mssql_loader_test4}) + } qr/Can't find source/, + 'no source registered for bad view'; + }, + }, ); -if( !$dsn || !$user ) { - $tester->skip_tests('You need to set the DBICTEST_MSSQL_DSN, _USER, and _PASS environment variables'); +if(not ($dbd_sybase_dsn || $odbc_dsn)) { + $tester->skip_tests('You need to set the DBICTEST_MSSQL_DSN, _USER and _PASS and/or the DBICTEST_MSSQL_ODBC_DSN, _USER and _PASS environment variables'); } else { $tester->run_tests(); diff --git a/t/16mssql_odbc_common.t b/t/16mssql_odbc_common.t deleted file mode 100644 index fd95f84..0000000 --- a/t/16mssql_odbc_common.t +++ /dev/null @@ -1,26 +0,0 @@ -use strict; -use lib qw(t/lib); -use dbixcsl_common_tests; -use dbixcsl_mssql_extra_tests; - -my $dsn = $ENV{DBICTEST_MSSQL_ODBC_DSN} || ''; -my $user = $ENV{DBICTEST_MSSQL_ODBC_USER} || ''; -my $password = $ENV{DBICTEST_MSSQL_ODBC_PASS} || ''; - -my $tester = dbixcsl_common_tests->new( - vendor => 'mssql', - auto_inc_pk => 'INTEGER IDENTITY NOT NULL PRIMARY KEY', - default_function => 'getdate()', - default_function_def => 'DATETIME DEFAULT getdate()', - dsn => $dsn, - user => $user, - password => $password, - extra => dbixcsl_mssql_extra_tests->extra, -); - -if( !$dsn || !$user ) { - $tester->skip_tests('You need to set the DBICTEST_MSSQL_ODBC_DSN, _USER, and _PASS environment variables'); -} -else { - $tester->run_tests(); -} diff --git a/t/18firebird_common.t b/t/18firebird_common.t index dc02e95..295bec3 100644 --- a/t/18firebird_common.t +++ b/t/18firebird_common.t @@ -1,11 +1,19 @@ use strict; +use warnings; +use Test::More; +use Scope::Guard (); use lib qw(t/lib); use dbixcsl_common_tests; -use dbixcsl_firebird_extra_tests; -my $dsn = $ENV{DBICTEST_FIREBIRD_DSN} || ''; -my $user = $ENV{DBICTEST_FIREBIRD_USER} || ''; -my $password = $ENV{DBICTEST_FIREBIRD_PASS} || ''; +my $dbd_interbase_dsn = $ENV{DBICTEST_FIREBIRD_DSN} || ''; +my $dbd_interbase_user = $ENV{DBICTEST_FIREBIRD_USER} || ''; +my $dbd_interbase_password = $ENV{DBICTEST_FIREBIRD_PASS} || ''; + +my $odbc_dsn = $ENV{DBICTEST_FIREBIRD_ODBC_DSN} || ''; +my $odbc_user = $ENV{DBICTEST_FIREBIRD_ODBC_USER} || ''; +my $odbc_password = $ENV{DBICTEST_FIREBIRD_ODBC_PASS} || ''; + +my $schema; my $tester = dbixcsl_common_tests->new( vendor => 'Firebird', @@ -34,22 +42,97 @@ my $tester = dbixcsl_common_tests->new( }, null => '', loader_options => { unquoted_ddl => 1 }, - extra => dbixcsl_firebird_extra_tests->extra, - dsn => $dsn, - user => $user, - password => $password, - connect_info_opts => { on_connect_call => 'use_softcommit' }, + connect_info => [ ($dbd_interbase_dsn ? { + dsn => $dbd_interbase_dsn, + user => $dbd_interbase_user, + password => $dbd_interbase_password, + connect_info_opts => { on_connect_call => 'use_softcommit' }, + } : ()), + ($odbc_dsn ? { + dsn => $odbc_dsn, + user => $odbc_user, + password => $odbc_password, + } : ()), + ], + extra => { + count => 6, + run => sub { + $schema = shift; + + cleanup_extra(); + + my $dbh = $schema->storage->dbh; + +# create a mixed case table + $dbh->do($_) for ( +q{ + CREATE TABLE "Firebird_Loader_Test1" ( + "Id" INTEGER NOT NULL PRIMARY KEY, + "Foo" INTEGER DEFAULT 42 + ) +}, +q{ + CREATE GENERATOR "Gen_Firebird_Loader_Test1_Id" +}, +q{ + CREATE TRIGGER "Firebird_Loader_Test1_BI" for "Firebird_Loader_Test1" + ACTIVE BEFORE INSERT POSITION 0 + AS + BEGIN + IF (NEW."Id" IS NULL) THEN + NEW."Id" = GEN_ID("Gen_Firebird_Loader_Test1_Id",1); + END +}, + ); + + my $guard = Scope::Guard->new(\&cleanup_extra); + + $schema->_loader->{unquoted_ddl} = 0; + $schema->_loader->_setup; + { + local $SIG{__WARN__} = sub {}; + $schema->rescan; + } + + ok ((my $rsrc = eval { $schema->resultset('FirebirdLoaderTest1')->result_source }), + 'got rsrc for mixed case table'); + + ok ((my $col_info = eval { $rsrc->column_info('Id') }), + 'got column_info for column Id'); + + is $col_info->{accessor}, 'id', 'column Id has lowercase accessor "id"'; + + is $col_info->{is_auto_increment}, 1, 'is_auto_increment detected for mixed case trigger'; + + is $col_info->{sequence}, 'Gen_Firebird_Loader_Test1_Id', 'correct mixed case sequence name'; + + is eval { $rsrc->column_info('Foo')->{default_value} }, 42, 'default_value detected for mixed case column'; + }, + }, ); -if( !$dsn ) { - $tester->skip_tests('You need to set the DBICTEST_FIREBIRD_DSN, _USER, and _PASS environment variables'); +if (not ($dbd_interbase_dsn || $odbc_dsn)) { + $tester->skip_tests('You need to set the DBICTEST_FIREBIRD_DSN, _USER and _PASS and/or the DBICTEST_FIREBIRD_ODBC_DSN, _USER and _PASS environment variables'); } else { # get rid of stupid warning from InterBase/GetInfo.pm - { + if ($dbd_interbase_dsn) { local $SIG{__WARN__} = sub {}; require DBD::InterBase; require DBD::InterBase::GetInfo; } $tester->run_tests(); } + +sub cleanup_extra { + $schema->storage->disconnect; + my $dbh = $schema->storage->dbh; + + foreach my $stmt ( + 'DROP TRIGGER "Firebird_Loader_Test1_BI"', + 'DROP GENERATOR "Gen_Firebird_Loader_Test1_Id"', + 'DROP TABLE "Firebird_Loader_Test1"', + ) { + eval { $dbh->do($stmt) }; + } +} diff --git a/t/18firebird_odbc_common.t b/t/18firebird_odbc_common.t deleted file mode 100644 index 3c48e61..0000000 --- a/t/18firebird_odbc_common.t +++ /dev/null @@ -1,48 +0,0 @@ -use strict; -use lib qw(t/lib); -use dbixcsl_common_tests; -use dbixcsl_firebird_extra_tests; - -my $dsn = $ENV{DBICTEST_FIREBIRD_ODBC_DSN} || ''; -my $user = $ENV{DBICTEST_FIREBIRD_ODBC_USER} || ''; -my $password = $ENV{DBICTEST_FIREBIRD_ODBC_PASS} || ''; - -my $tester = dbixcsl_common_tests->new( - vendor => 'Firebird', - auto_inc_pk => 'INTEGER NOT NULL PRIMARY KEY', - auto_inc_cb => sub { - my ($table, $col) = @_; - return ( - qq{ CREATE GENERATOR gen_${table}_${col} }, - qq{ - CREATE TRIGGER ${table}_bi FOR $table - ACTIVE BEFORE INSERT POSITION 0 - AS - BEGIN - IF (NEW.$col IS NULL) THEN - NEW.$col = GEN_ID(gen_${table}_${col},1); - END - } - ); - }, - auto_inc_drop_cb => sub { - my ($table, $col) = @_; - return ( - qq{ DROP TRIGGER ${table}_bi }, - qq{ DROP GENERATOR gen_${table}_${col} }, - ); - }, - null => '', - loader_options => { unquoted_ddl => 1 }, - extra => dbixcsl_firebird_extra_tests->extra, - dsn => $dsn, - user => $user, - password => $password, -); - -if( !$dsn ) { - $tester->skip_tests('You need to set the DBICTEST_FIREBIRD_ODBC_DSN, _USER, and _PASS environment variables'); -} -else { - $tester->run_tests(); -} diff --git a/t/lib/dbixcsl_common_tests.pm b/t/lib/dbixcsl_common_tests.pm index 059979d..97de888 100644 --- a/t/lib/dbixcsl_common_tests.pm +++ b/t/lib/dbixcsl_common_tests.pm @@ -10,6 +10,7 @@ use File::Path; use DBI; use Digest::MD5; use File::Find 'find'; +use Class::Unload (); my $DUMP_DIR = './t/_common_dump'; rmtree $DUMP_DIR; @@ -85,20 +86,32 @@ sub _custom_column_info { sub run_tests { my $self = shift; - plan tests => 159 + ($self->{extra}->{count} || 0); + my @connect_info; - $self->create(); + if ($self->{dsn}) { + push @connect_info, [ @{$self}{qw/dsn user password connect_info_opts/ } ]; + } + else { + foreach my $info (@{ $self->{connect_info} || [] }) { + push @connect_info, [ @{$info}{qw/dsn user password connect_info_opts/ } ]; + } + } - my @connect_info = ( - $self->{dsn}, - $self->{user}, - $self->{password}, - $self->{connect_info_opts}, - ); + plan tests => @connect_info * (159 + ($self->{extra}->{count} || 0)); + + foreach my $info_idx (0..$#connect_info) { + my $info = $connect_info[$info_idx]; - # First, with in-memory classes - my $schema_class = $self->setup_schema(@connect_info); - $self->test_schema($schema_class); + @{$self}{qw/dsn user password connect_info_opts/} = @$info; + + $self->create(); + + my $schema_class = $self->setup_schema(@$info); + $self->test_schema($schema_class); + + rmtree $DUMP_DIR + unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP} && $info_idx == $#connect_info; + } } # defined in sub create @@ -137,6 +150,8 @@ sub setup_schema { $loader_opts{db_schema} = $self->{db_schema} if $self->{db_schema}; + Class::Unload->unload($schema_class); + my $file_count; my $expected_count = 36; { @@ -824,6 +839,8 @@ sub test_schema { $self->{extra}->{run}->($conn, $monikers, $classes) if $self->{extra}->{run}; + $self->drop_tables unless $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}; + $conn->storage->disconnect; } @@ -855,6 +872,7 @@ sub dbconnect { RaiseError => $complain, ShowErrorStatement => $complain, PrintError => 0, + %{ $self->{connect_info_opts} || {} }, }, ]); @@ -966,8 +984,8 @@ sub create { id1 INTEGER NOT NULL, iD2 INTEGER NOT NULL, dat VARCHAR(8), - from_id INTEGER, - to_id INTEGER, + from_id INTEGER $self->{null}, + to_id INTEGER $self->{null}, PRIMARY KEY (id1,iD2), FOREIGN KEY (from_id) REFERENCES loader_test4 (id), FOREIGN KEY (to_id) REFERENCES loader_test4 (id) diff --git a/t/lib/dbixcsl_firebird_extra_tests.pm b/t/lib/dbixcsl_firebird_extra_tests.pm deleted file mode 100644 index 582a180..0000000 --- a/t/lib/dbixcsl_firebird_extra_tests.pm +++ /dev/null @@ -1,67 +0,0 @@ -package dbixcsl_firebird_extra_tests; - -use strict; -use warnings; -use Test::More; -use Test::Exception; - -sub extra { +{ - pre_drop_ddl => [ - q{DROP TRIGGER "Firebird_Loader_Test1_BI"}, - q{DROP GENERATOR "Gen_Firebird_Loader_Test1_Id"}, - ], - drop => [ - q{"Firebird_Loader_Test1"} - ], - count => 6, - run => sub { - my ($schema, $monikers, $classes) = @_; - - my $dbh = $schema->storage->dbh; - -# create a mixed case table - $dbh->do($_) for ( -q{ - CREATE TABLE "Firebird_Loader_Test1" ( - "Id" INTEGER NOT NULL PRIMARY KEY, - "Foo" INTEGER DEFAULT 42 - ) -}, -q{ - CREATE GENERATOR "Gen_Firebird_Loader_Test1_Id" -}, -q{ - CREATE TRIGGER "Firebird_Loader_Test1_BI" for "Firebird_Loader_Test1" - ACTIVE BEFORE INSERT POSITION 0 - AS - BEGIN - IF (NEW."Id" IS NULL) THEN - NEW."Id" = GEN_ID("Gen_Firebird_Loader_Test1_Id",1); - END -}, - ); - - $schema->_loader->{unquoted_ddl} = 0; - $schema->_loader->_setup; - { - local $SIG{__WARN__} = sub {}; - $schema->rescan; - } - - ok ((my $rsrc = eval { $schema->resultset('FirebirdLoaderTest1')->result_source }), - 'got rsrc for mixed case table'); - - ok ((my $col_info = eval { $rsrc->column_info('Id') }), - 'got column_info for column Id'); - - is $col_info->{accessor}, 'id', 'column Id has lowercase accessor "id"'; - - is $col_info->{is_auto_increment}, 1, 'is_auto_increment detected for mixed case trigger'; - - is $col_info->{sequence}, 'Gen_Firebird_Loader_Test1_Id', 'correct mixed case sequence name'; - - is eval { $rsrc->column_info('Foo')->{default_value} }, 42, 'default_value detected for mixed case column'; - }, -}} - -1; diff --git a/t/lib/dbixcsl_mssql_extra_tests.pm b/t/lib/dbixcsl_mssql_extra_tests.pm deleted file mode 100644 index 4102203..0000000 --- a/t/lib/dbixcsl_mssql_extra_tests.pm +++ /dev/null @@ -1,81 +0,0 @@ -package dbixcsl_mssql_extra_tests; - -use strict; -use warnings; -use Test::More; -use Test::Exception; - -sub extra { +{ - create => [ - q{ - CREATE TABLE [mssql_loader_test1.dot] ( - id INT IDENTITY NOT NULL PRIMARY KEY, - dat VARCHAR(8) - ) - }, - q{ - CREATE TABLE mssql_loader_test3 ( - id INT IDENTITY NOT NULL PRIMARY KEY - ) - }, - q{ - CREATE VIEW mssql_loader_test4 AS - SELECT * FROM mssql_loader_test3 - }, - ], - pre_drop_ddl => [ - 'CREATE TABLE mssql_loader_test3 (id INT IDENTITY NOT NULL PRIMARY KEY)', - 'DROP VIEW mssql_loader_test4', - ], - drop => [ - '[mssql_loader_test1.dot]', - 'mssql_loader_test3' - ], - count => 8, - run => sub { - my ($schema, $monikers, $classes) = @_; - -# Test that the table above (with '.' in name) gets loaded correctly. - ok((my $rs = eval { - $schema->resultset($monikers->{'[mssql_loader_test1.dot]'}) }), - 'got a resultset for table with dot in name'); - - ok((my $from = eval { $rs->result_source->from }), - 'got an $rsrc->from for table with dot in name'); - - is ref($from), 'SCALAR', '->table with dot in name is a scalar ref'; - - is eval { $$from }, "[mssql_loader_test1.dot]", - '->table with dot in name has correct name'; - -# Test that identity columns do not have 'identity' in the data_type, and do -# have is_auto_increment. - my $identity_col_info = $schema->resultset($monikers->{loader_test10}) - ->result_source->column_info('id10'); - - is $identity_col_info->{data_type}, 'int', - q{'INT IDENTITY' column has data_type => 'int'}; - - is $identity_col_info->{is_auto_increment}, 1, - q{'INT IDENTITY' column has is_auto_increment => 1}; - -# Test that a bad view (where underlying table is gone) is ignored. - my $dbh = $schema->storage->dbh; - $dbh->do("DROP TABLE mssql_loader_test3"); - - my @warnings; - { - local $SIG{__WARN__} = sub { push @warnings, $_[0] }; - $schema->rescan; - } - ok ((grep /^Bad table or view 'mssql_loader_test4'/, @warnings), - 'bad view ignored'); - - throws_ok { - $schema->resultset($monikers->{mssql_loader_test4}) - } qr/Can't find source/, - 'no source registered for bad view'; - }, -}} - -1;