X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F10_04db2_common.t;h=0533dc0726ad0b2c4f7f4a34153c3c4adc18e178;hb=46e71a1b3527936e885facc87a97c586d25ecc67;hp=e5d5a0ee45f030bb5774e7aafbf0cdd5a0113ef2;hpb=567aa05681cd48788d132c016b357dc485d54f35;p=dbsrgits%2FDBIx-Class-Schema-Loader.git diff --git a/t/10_04db2_common.t b/t/10_04db2_common.t index e5d5a0e..0533dc0 100644 --- a/t/10_04db2_common.t +++ b/t/10_04db2_common.t @@ -1,13 +1,26 @@ -use strict; +use DBIx::Class::Schema::Loader::Optional::Dependencies + -skip_all_without => 'test_rdbms_db2'; +use strict; +use warnings; use Test::More; +use Test::Exception; +use Try::Tiny; +use File::Path 'rmtree'; +use DBIx::Class::Schema::Loader 'make_schema_at'; + +use lib qw(t/lib); + +use dbixcsl_common_tests (); +use dbixcsl_test_dir '$tdir'; + +use constant EXTRA_DUMP_DIR => "$tdir/db2_extra_dump"; my $dsn = $ENV{DBICTEST_DB2_DSN} || ''; my $user = $ENV{DBICTEST_DB2_USER} || ''; my $password = $ENV{DBICTEST_DB2_PASS} || ''; -plan skip_all => 'You need to set the DBICTEST_DB2_DSN, _USER, and _PASS environment variables' - unless ($dsn && $user); +my ($schema, $schemas_created); # for cleanup in END for extra tests my $srv_ver = do { require DBI; @@ -16,9 +29,6 @@ my $srv_ver = do { }; my ($maj_srv_ver) = $srv_ver =~ /^(\d+)/; -use lib qw(t/lib); -use dbixcsl_common_tests; - my $extra_graphics_data_types = { graphic => { data_type => 'graphic', size => 1 }, 'graphic(3)' => { data_type => 'graphic', size => 3 }, @@ -27,7 +37,7 @@ my $extra_graphics_data_types = { 'dbclob' => { data_type => 'dbclob' }, }; -my $tester = dbixcsl_common_tests->new( +dbixcsl_common_tests->new( vendor => 'DB2', auto_inc_pk => 'INTEGER GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY', dsn => $dsn, @@ -36,6 +46,8 @@ my $tester = dbixcsl_common_tests->new( null => '', preserve_case_mode_is_exclusive => 1, quote_char => '"', + default_is_deferrable => 1, + default_on_clause => 'NO ACTION', data_types => { # http://publib.boulder.ibm.com/infocenter/db2luw/v8/index.jsp?topic=/com.ibm.db2.udb.doc/admin/r0008483.htm # @@ -93,8 +105,282 @@ my $tester = dbixcsl_common_tests->new( # XXX I don't know how to make these # datalink => { data_type => 'datalink' }, }, -); + extra => { + create => [ + # 4 through 8 are used for the multi-schema tests + q{ + create table db2_loader_test9 ( + id int generated by default as identity not null primary key + ) + }, + q{ + create table db2_loader_test10 ( + id int generated by default as identity not null primary key, + nine_id int, + foreign key (nine_id) references db2_loader_test9(id) + on delete set null on update restrict + ) + }, + ], + drop => [ qw/db2_loader_test9 db2_loader_test10/ ], + count => 4 + 30 * 2, + run => sub { + $schema = shift; + + # test on delete/update fk clause introspection + ok ((my $rel_info = $schema->source('Db2LoaderTest10')->relationship_info('nine')), + 'got rel info'); + + is $rel_info->{attrs}{on_delete}, 'SET NULL', + 'ON DELETE clause introspected correctly'; + + is $rel_info->{attrs}{on_update}, 'RESTRICT', + 'ON UPDATE clause introspected correctly'; + + is $rel_info->{attrs}{is_deferrable}, 1, + 'DEFERRABLE defaults to 1'; + + SKIP: { + my $dbh = $schema->storage->dbh; + + try { + $dbh->do('CREATE SCHEMA "dbicsl-test"'); + } + catch { + $schemas_created = 0; + skip "no CREATE SCHEMA privileges", 30 * 2; + }; + + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl-test".db2_loader_test4 ( + id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100) + ) +EOF + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl-test".db2_loader_test5 ( + id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100), + four_id INTEGER NOT NULL, + CONSTRAINT loader_test5_uniq UNIQUE (four_id), + FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id) + ) +EOF + $dbh->do('CREATE SCHEMA "dbicsl.test"'); + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl.test".db2_loader_test5 ( + pk INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100), + four_id INTEGER NOT NULL, + CONSTRAINT loader_test5_uniq UNIQUE (four_id), + FOREIGN KEY (four_id) REFERENCES "dbicsl-test".db2_loader_test4 (id) + ) +EOF + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl.test".db2_loader_test6 ( + id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100), + db2_loader_test4_id INTEGER, + FOREIGN KEY (db2_loader_test4_id) REFERENCES "dbicsl-test".db2_loader_test4 (id) + ) +EOF + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl.test".db2_loader_test7 ( + id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100), + six_id INTEGER NOT NULL UNIQUE, + FOREIGN KEY (six_id) REFERENCES "dbicsl.test".db2_loader_test6 (id) + ) +EOF + $dbh->do(<<"EOF"); + CREATE TABLE "dbicsl-test".db2_loader_test8 ( + id INT GENERATED BY DEFAULT AS IDENTITY NOT NULL PRIMARY KEY, + value VARCHAR(100), + db2_loader_test7_id INTEGER, + FOREIGN KEY (db2_loader_test7_id) REFERENCES "dbicsl.test".db2_loader_test7 (id) + ) +EOF + + $schemas_created = 1; + + foreach my $db_schema (['dbicsl-test', 'dbicsl.test'], '%') { + lives_and { + rmtree EXTRA_DUMP_DIR; + + my @warns; + local $SIG{__WARN__} = sub { + push @warns, $_[0] unless $_[0] =~ /\bcollides\b/; + }; + + make_schema_at( + 'DB2MultiSchema', + { + naming => 'current', + db_schema => $db_schema, + dump_directory => EXTRA_DUMP_DIR, + quiet => 1, + }, + [ $dsn, $user, $password ], + ); + + diag join "\n", @warns if @warns; + + is @warns, 0; + } 'dumped schema for "dbicsl-test" and "dbicsl.test" schemas with no warnings'; + + my ($test_schema, $rsrc, $rs, $row, %uniqs, $rel_info); + + lives_and { + ok $test_schema = DB2MultiSchema->connect($dsn, $user, $password); + } 'connected test schema'; + + lives_and { + ok $rsrc = $test_schema->source('Db2LoaderTest4'); + } 'got source for table in schema name with dash'; + + is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, + 'column in schema name with dash'; + + is try { $rsrc->column_info('value')->{data_type} }, 'varchar', + 'column in schema name with dash'; + + is try { $rsrc->column_info('value')->{size} }, 100, + 'column in schema name with dash'; + + lives_and { + ok $rs = $test_schema->resultset('Db2LoaderTest4'); + } 'got resultset for table in schema name with dash'; + + lives_and { + ok $row = $rs->create({ value => 'foo' }); + } 'executed SQL on table in schema name with dash'; + + $rel_info = try { $rsrc->relationship_info('dbicsl_dash_test_db2_loader_test5') }; + + is_deeply $rel_info->{cond}, { + 'foreign.four_id' => 'self.id' + }, 'relationship in schema name with dash'; + + is $rel_info->{attrs}{accessor}, 'single', + 'relationship in schema name with dash'; + + is $rel_info->{attrs}{join_type}, 'LEFT', + 'relationship in schema name with dash'; + + lives_and { + ok $rsrc = $test_schema->source('DbicslDashTestDb2LoaderTest5'); + } 'got source for table in schema name with dash'; + + %uniqs = try { $rsrc->unique_constraints }; + + is keys %uniqs, 2, + 'got unique and primary constraint in schema name with dash'; + + delete $uniqs{primary}; + + is_deeply ((values %uniqs)[0], ['four_id'], + 'correct unique constraint in schema name with dash'); + + lives_and { + ok $rsrc = $test_schema->source('Db2LoaderTest6'); + } 'got source for table in schema name with dot'; + + is try { $rsrc->column_info('id')->{is_auto_increment} }, 1, + 'column in schema name with dot introspected correctly'; + + is try { $rsrc->column_info('value')->{data_type} }, 'varchar', + 'column in schema name with dot introspected correctly'; + + is try { $rsrc->column_info('value')->{size} }, 100, + 'column in schema name with dot introspected correctly'; + + lives_and { + ok $rs = $test_schema->resultset('Db2LoaderTest6'); + } 'got resultset for table in schema name with dot'; + + lives_and { + ok $row = $rs->create({ value => 'foo' }); + } 'executed SQL on table in schema name with dot'; + + $rel_info = try { $rsrc->relationship_info('db2_loader_test7') }; + + is_deeply $rel_info->{cond}, { + 'foreign.six_id' => 'self.id' + }, 'relationship in schema name with dot'; + + is $rel_info->{attrs}{accessor}, 'single', + 'relationship in schema name with dot'; + + is $rel_info->{attrs}{join_type}, 'LEFT', + 'relationship in schema name with dot'; + + lives_and { + ok $rsrc = $test_schema->source('Db2LoaderTest7'); + } 'got source for table in schema name with dot'; + + %uniqs = try { $rsrc->unique_constraints }; + + is keys %uniqs, 2, + 'got unique and primary constraint in schema name with dot'; + + delete $uniqs{primary}; + + is_deeply ((values %uniqs)[0], ['six_id'], + 'correct unique constraint in schema name with dot'); + + lives_and { + ok $test_schema->source('Db2LoaderTest6') + ->has_relationship('db2_loader_test4'); + } 'cross-schema relationship in multi-db_schema'; + + lives_and { + ok $test_schema->source('Db2LoaderTest4') + ->has_relationship('db2_loader_test6s'); + } 'cross-schema relationship in multi-db_schema'; + + lives_and { + ok $test_schema->source('Db2LoaderTest8') + ->has_relationship('db2_loader_test7'); + } 'cross-schema relationship in multi-db_schema'; + + lives_and { + ok $test_schema->source('Db2LoaderTest7') + ->has_relationship('db2_loader_test8s'); + } 'cross-schema relationship in multi-db_schema'; + } + } + + }, + }, +)->run_tests(); -$tester->run_tests(); +END { + if (not $ENV{SCHEMA_LOADER_TESTS_NOCLEANUP}) { + if ($schemas_created && (my $dbh = try { $schema->storage->dbh })) { + foreach my $table ('"dbicsl-test".db2_loader_test8', + '"dbicsl.test".db2_loader_test7', + '"dbicsl.test".db2_loader_test6', + '"dbicsl-test".db2_loader_test5', + '"dbicsl.test".db2_loader_test5', + '"dbicsl-test".db2_loader_test4') { + try { + $dbh->do("DROP TABLE $table"); + } + catch { + diag "Error dropping table: $_"; + }; + } + foreach my $db_schema (qw/dbicsl-test dbicsl.test/) { + try { + $dbh->do(qq{DROP SCHEMA "$db_schema" RESTRICT}); + } + catch { + diag "Error dropping test schema $db_schema: $_"; + }; + } + } + rmtree EXTRA_DUMP_DIR; + } +} # vim:et sts=4 sw=4 tw=0: