X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2F72pg.t;h=542b915080a61907a3d4557eccc159b82a28e2c8;hb=6d766626a066b757058d023830f93cf39bb9c302;hp=790b0062d09b47ac144dc561b5c9b1daec5894aa;hpb=f295a73c74917b651c514b498b8e894a60acfbc7;p=dbsrgits%2FDBIx-Class.git diff --git a/t/72pg.t b/t/72pg.t index 790b006..542b915 100644 --- a/t/72pg.t +++ b/t/72pg.t @@ -11,285 +11,308 @@ my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; plan skip_all => <load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes; - -### pre-connect tests -{ +my $test_server_supports_insert_returning = do { my $s = DBICTest::Schema->connect($dsn, $user, $pass); + $s->storage->_determine_driver; + $s->storage->_supports_insert_returning; +}; - ok (!$s->storage->_dbh, 'definitely not connected'); +my $schema; - # Check that datetime_parser returns correctly before we explicitly connect. - SKIP: { - eval { require DateTime::Format::Pg }; - skip "DateTime::Format::Pg required", 2 if $@; +for my $use_insert_returning ($test_server_supports_insert_returning + ? (0,1) + : (0) +) { + no warnings qw/redefine once/; + local *DBIx::Class::Storage::DBI::Pg::_supports_insert_returning = sub { + $use_insert_returning + }; - my $store = ref $s->storage; - is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage'); +### pre-connect tests (keep each test separate as to make sure rebless() runs) + { + my $s = DBICTest::Schema->connect($dsn, $user, $pass); - my $parser = $s->storage->datetime_parser; - is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected'); - } + ok (!$s->storage->_dbh, 'definitely not connected'); + # Check that datetime_parser returns correctly before we explicitly connect. + SKIP: { + eval { require DateTime::Format::Pg }; + skip "DateTime::Format::Pg required", 2 if $@; - # make sure sqlt_type overrides work (::Storage::DBI::Pg does this) - is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection'); -} + my $store = ref $s->storage; + is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage'); + + my $parser = $s->storage->datetime_parser; + is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected'); + } + + ok (!$s->storage->_dbh, 'still not connected'); + } + { + my $s = DBICTest::Schema->connect($dsn, $user, $pass); + # make sure sqlt_type overrides work (::Storage::DBI::Pg does this) + ok (!$s->storage->_dbh, 'definitely not connected'); + is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection'); + ok (!$s->storage->_dbh, 'still not connected'); + } ### connect, create postgres-specific test schema -my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + $schema = DBICTest::Schema->connect($dsn, $user, $pass); + $schema->storage->ensure_connected; -drop_test_schema($schema, 'no warn'); -create_test_schema($schema); + drop_test_schema($schema); + create_test_schema($schema); ### begin main tests - # run a BIG bunch of tests for last-insert-id / Auto-PK / sequence # discovery -run_apk_tests($schema); #< older set of auto-pk tests -run_extended_apk_tests($schema); #< new extended set of auto-pk tests + run_apk_tests($schema); #< older set of auto-pk tests + run_extended_apk_tests($schema); #< new extended set of auto-pk tests ### type_info tests -my $test_type_info = { - 'artistid' => { - 'data_type' => 'integer', - 'is_nullable' => 0, - 'size' => 4, - }, - 'name' => { - 'data_type' => 'character varying', - 'is_nullable' => 1, - 'size' => 100, - 'default_value' => undef, - }, - 'rank' => { - 'data_type' => 'integer', - 'is_nullable' => 0, - 'size' => 4, - 'default_value' => 13, - - }, - 'charfield' => { - 'data_type' => 'character', - 'is_nullable' => 1, - 'size' => 10, - 'default_value' => undef, - }, - 'arrayfield' => { - 'data_type' => 'integer[]', - 'is_nullable' => 1, - 'size' => undef, - 'default_value' => undef, - }, -}; - -my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist'); -my $artistid_defval = delete $type_info->{artistid}->{default_value}; -like($artistid_defval, - qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, - 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'); -is_deeply($type_info, $test_type_info, - 'columns_info_for - column data types'); + my $test_type_info = { + 'artistid' => { + 'data_type' => 'integer', + 'is_nullable' => 0, + 'size' => 4, + }, + 'name' => { + 'data_type' => 'character varying', + 'is_nullable' => 1, + 'size' => 100, + 'default_value' => undef, + }, + 'rank' => { + 'data_type' => 'integer', + 'is_nullable' => 0, + 'size' => 4, + 'default_value' => 13, + + }, + 'charfield' => { + 'data_type' => 'character', + 'is_nullable' => 1, + 'size' => 10, + 'default_value' => undef, + }, + 'arrayfield' => { + 'data_type' => 'integer[]', + 'is_nullable' => 1, + 'size' => undef, + 'default_value' => undef, + }, + }; + + my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist'); + my $artistid_defval = delete $type_info->{artistid}->{default_value}; + like($artistid_defval, + qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, + 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'); + is_deeply($type_info, $test_type_info, + 'columns_info_for - column data types'); ####### Array tests -BEGIN { - package DBICTest::Schema::ArrayTest; - push @main::test_classes, __PACKAGE__; + BEGIN { + package DBICTest::Schema::ArrayTest; + push @main::test_classes, __PACKAGE__; - use strict; - use warnings; - use base 'DBIx::Class'; + use strict; + use warnings; + use base 'DBIx::Class::Core'; - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('dbic_t_schema.array_test'); - __PACKAGE__->add_columns(qw/id arrayfield/); - __PACKAGE__->column_info_from_storage(1); - __PACKAGE__->set_primary_key('id'); + __PACKAGE__->table('dbic_t_schema.array_test'); + __PACKAGE__->add_columns(qw/id arrayfield/); + __PACKAGE__->column_info_from_storage(1); + __PACKAGE__->set_primary_key('id'); -} -SKIP: { - skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002; + } + SKIP: { + skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002; - lives_ok { - $schema->resultset('ArrayTest')->create({ - arrayfield => [1, 2], - }); - } 'inserting arrayref as pg array data'; + lives_ok { + $schema->resultset('ArrayTest')->create({ + arrayfield => [1, 2], + }); + } 'inserting arrayref as pg array data'; - lives_ok { - $schema->resultset('ArrayTest')->update({ - arrayfield => [3, 4], - }); - } 'updating arrayref as pg array data'; + lives_ok { + $schema->resultset('ArrayTest')->update({ + arrayfield => [3, 4], + }); + } 'updating arrayref as pg array data'; - $schema->resultset('ArrayTest')->create({ - arrayfield => [5, 6], - }); + $schema->resultset('ArrayTest')->create({ + arrayfield => [5, 6], + }); - my $count; - lives_ok { - $count = $schema->resultset('ArrayTest')->search({ - arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #Todo anything less ugly than this? - })->count; - } 'comparing arrayref to pg array data does not blow up'; - is($count, 1, 'comparing arrayref to pg array data gives correct result'); -} + my $count; + lives_ok { + $count = $schema->resultset('ArrayTest')->search({ + arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #Todo anything less ugly than this? + })->count; + } 'comparing arrayref to pg array data does not blow up'; + is($count, 1, 'comparing arrayref to pg array data gives correct result'); + } ########## Case check -BEGIN { - package DBICTest::Schema::Casecheck; - push @main::test_classes, __PACKAGE__; + BEGIN { + package DBICTest::Schema::Casecheck; + push @main::test_classes, __PACKAGE__; - use strict; - use warnings; - use base 'DBIx::Class'; - - __PACKAGE__->load_components(qw/Core/); - __PACKAGE__->table('dbic_t_schema.casecheck'); - __PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/); - __PACKAGE__->column_info_from_storage(1); - __PACKAGE__->set_primary_key('id'); - - sub store_column { - my ($self, $name, $value) = @_; - $value = '#'.$value if($name eq "storecolumn"); - $self->maybe::next::method($name, $value); - } -} + use strict; + use warnings; + use base 'DBIx::Class::Core'; -# store_column is called once for create() for non sequence columns -ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'})); -is($storecolumn->storecolumn, '#a'); # was '##a' + __PACKAGE__->table('dbic_t_schema.casecheck'); + __PACKAGE__->add_columns(qw/id name NAME uc_name/); + __PACKAGE__->column_info_from_storage(1); + __PACKAGE__->set_primary_key('id'); + } -my $name_info = $schema->source('Casecheck')->column_info( 'name' ); -is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); + my $name_info = $schema->source('Casecheck')->column_info( 'name' ); + is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); -my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' ); -is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); + my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' ); + is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); -my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' ); -is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); + my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' ); + is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); ## Test SELECT ... FOR UPDATE -my $HaveSysSigAction = eval "require Sys::SigAction" && !$@; -if( $HaveSysSigAction ) { - Sys::SigAction->import( 'set_sig_handler' ); -} -SKIP: { - skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction; - # create a new schema - my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); - $schema2->source("Artist")->name("dbic_t_schema.artist"); - - $schema->txn_do( sub { - my $artist = $schema->resultset('Artist')->search( - { - artistid => 1 - }, - { - for => 'update' - } - )->first; - is($artist->artistid, 1, "select for update returns artistid = 1"); - - my $artist_from_schema2; - my $error_ok = 0; - eval { - my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); - alarm(2); - $artist_from_schema2 = $schema2->resultset('Artist')->find(1); - $artist_from_schema2->name('fooey'); - $artist_from_schema2->update; - alarm(0); - }; - if (my $e = $@) { - $error_ok = $e =~ /DBICTestTimeout/; - } + SKIP: { + if(eval "require Sys::SigAction" && !$@) { + Sys::SigAction->import( 'set_sig_handler' ); + } + else { + skip "Sys::SigAction is not available", 6; + } - # Make sure that an error was raised, and that the update failed - ok($error_ok, "update from second schema times out"); - ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema"); - }); -} + my ($timed_out, $artist2); + + for my $t ( + { + # Make sure that an error was raised, and that the update failed + update_lock => 1, + test_sub => sub { + ok($timed_out, "update from second schema times out"); + ok($artist2->is_column_changed('name'), "'name' column is still dirty from second schema"); + }, + }, + { + # Make sure that an error was NOT raised, and that the update succeeded + update_lock => 0, + test_sub => sub { + ok(! $timed_out, "update from second schema DOES NOT timeout"); + ok(! $artist2->is_column_changed('name'), "'name' column is NOT dirty from second schema"); + }, + }, + ) { + # create a new schema + my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); + $schema2->source("Artist")->name("dbic_t_schema.artist"); + + $schema->txn_do( sub { + my $artist = $schema->resultset('Artist')->search( + { + artistid => 1 + }, + $t->{update_lock} ? { for => 'update' } : {} + )->first; + is($artist->artistid, 1, "select returns artistid = 1"); + + $timed_out = 0; + eval { + my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); + alarm(2); + $artist2 = $schema2->resultset('Artist')->find(1); + $artist2->name('fooey'); + $artist2->update; + alarm(0); + }; + $timed_out = $@ =~ /DBICTestTimeout/; + }); + + $t->{test_sub}->(); + } + } -SKIP: { - skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction; - # create a new schema - my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); - $schema2->source("Artist")->name("dbic_t_schema.artist"); - - $schema->txn_do( sub { - my $artist = $schema->resultset('Artist')->search( - { - artistid => 1 - }, - )->first; - is($artist->artistid, 1, "select for update returns artistid = 1"); - - my $artist_from_schema2; - my $error_ok = 0; - eval { - my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); - alarm(2); - $artist_from_schema2 = $schema2->resultset('Artist')->find(1); - $artist_from_schema2->name('fooey'); - $artist_from_schema2->update; - alarm(0); - }; - if (my $e = $@) { - $error_ok = $e =~ /DBICTestTimeout/; - } - # Make sure that an error was NOT raised, and that the update succeeded - ok(! $error_ok, "update from second schema DOES NOT timeout"); - ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema"); - }); -} +######## other older Auto-pk tests + + $schema->source("SequenceTest")->name("dbic_t_schema.sequence_test"); + for (1..5) { + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); + is($st->pkid1, $_, "Auto-PK for sequence without default: First primary key"); + is($st->pkid2, $_ + 9, "Auto-PK for sequence without default: Second primary key"); + is($st->nonpkid, $_ + 19, "Auto-PK for sequence without default: Non-primary key"); + } + my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); + is($st->pkid1, 55, "Auto-PK for sequence without default: First primary key set manually"); -######## other older Auto-pk tests +######## test non-serial auto-pk + + if ($schema->storage->_supports_insert_returning) { + $schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_key_test'); + my $row = $schema->resultset('TimestampPrimaryKey')->create({}); + ok $row->id; + } + +######## test with_deferred_fk_checks + + $schema->source('CD')->name('dbic_t_schema.cd'); + $schema->source('Track')->name('dbic_t_schema.track'); + lives_ok { + $schema->storage->with_deferred_fk_checks(sub { + $schema->resultset('Track')->create({ + trackid => 999, cd => 999, position => 1, title => 'deferred FK track' + }); + $schema->resultset('CD')->create({ + artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd' + }); + }); + } 'with_deferred_fk_checks code survived'; + + is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track', + 'code in with_deferred_fk_checks worked'; -$schema->source("SequenceTest")->name("dbic_t_schema.sequence_test"); -for (1..5) { - my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); - is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key"); - is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key"); - is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key"); + throws_ok { + $schema->resultset('Track')->create({ + trackid => 1, cd => 9999, position => 1, title => 'Track1' + }); + } qr/constraint/i, 'with_deferred_fk_checks is off'; } -my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); -is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); done_testing; -exit; - END { + return unless $schema; drop_test_schema($schema); eapk_drop_all( $schema) }; @@ -316,6 +339,34 @@ EOS $dbh->do("CREATE SCHEMA dbic_t_schema"); $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table"); + + $dbh->do(<do(<do(<do(<do(<storage->dbh_do(sub { my (undef,$dbh) = @_; @@ -398,7 +448,7 @@ sub drop_test_schema { 'DROP SCHEMA dbic_t_schema_3 CASCADE', ) { eval { $dbh->do ($stat) }; - diag $@ if $@ && !$no_warn; + diag $@ if $@ && $warn_exceptions; } }); } @@ -474,9 +524,8 @@ BEGIN { use strict; use warnings; - use base 'DBIx::Class'; + use base 'DBIx::Class::Core'; - __PACKAGE__->load_components(qw/Core/); __PACKAGE__->table('apk'); @eapk_id_columns = qw( id1 id2 id3 id4 ); @@ -491,14 +540,16 @@ BEGIN { my @eapk_schemas; BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 } +my %seqs; #< hash of schema.table.col => currval of its (DBIC) primary key sequence sub run_extended_apk_tests { my $schema = shift; #save the search path and reset it at the end - my $search_path_save = $schema->storage->dbh_do('_get_pg_search_path'); + my $search_path_save = eapk_get_search_path($schema); - eapk_drop_all($schema,'no warn'); + eapk_drop_all($schema); + %seqs = (); # make the test schemas and sequences $schema->storage->dbh_do(sub { @@ -508,8 +559,18 @@ sub run_extended_apk_tests { for @eapk_schemas; $dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[5].fooseq',400)"); + $seqs{"$eapk_schemas[1].apk.id2"} = 400; + + $dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[4].fooseq',300)"); + $seqs{"$eapk_schemas[3].apk.id2"} = 300; + + $dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq"); + $dbh->do("SELECT setval('$eapk_schemas[3].fooseq',200)"); + $seqs{"$eapk_schemas[4].apk.id2"} = 200; - $dbh->do("SET search_path = ".join ',', @eapk_schemas ); + $dbh->do("SET search_path = ".join ',', reverse @eapk_schemas ); }); # clear our search_path cache @@ -526,14 +587,29 @@ sub run_extended_apk_tests { with_search_path => ['public',0,1], qualify_table => 2, ); + eapk_create( $schema, + with_search_path => [3,1,0,'public'], + nextval => "$eapk_schemas[4].fooseq", + ); + eapk_create( $schema, + with_search_path => [3,1,0,'public'], + nextval => "$eapk_schemas[3].fooseq", + qualify_table => 4, + ); - lives_ok { - $schema->resultset('ExtAPK')->create({}); - } 'create in first schema lives'; - + eapk_poke( $schema ); eapk_poke( $schema, 0 ); + eapk_poke( $schema, 2 ); + eapk_poke( $schema, 4 ); eapk_poke( $schema, 1 ); + eapk_poke( $schema, 0 ); + eapk_poke( $schema, 1 ); + eapk_poke( $schema ); + eapk_poke( $schema, 4 ); + eapk_poke( $schema, 3 ); eapk_poke( $schema, 1 ); + eapk_poke( $schema, 2 ); + eapk_poke( $schema, 0 ); # set our search path back eapk_set_search_path( $schema, @$search_path_save ); @@ -542,8 +618,6 @@ sub run_extended_apk_tests { # do a DBIC create on the apk table in the given schema number (which is an # index of @eapk_schemas) -my %seqs; #< sanity-check hash of schema.table.col => currval of its sequence - sub eapk_poke { my ($s, $schema_num) = @_; @@ -551,9 +625,9 @@ sub eapk_poke { ? $eapk_schemas[$schema_num] : ''; - my $schema_name_actual = $schema_name || $s->storage->dbh_do('_get_pg_search_path')->[0]; + my $schema_name_actual = $schema_name || eapk_find_visible_schema($s); - $s->source('ExtAPK')->name($schema_name.'apk'); + $s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk'); #< clear sequence name cache $s->source('ExtAPK')->column_info($_)->{sequence} = undef for @eapk_id_columns; @@ -562,22 +636,27 @@ sub eapk_poke { lives_ok { my $new; for my $inc (1,2,3) { - $new = $schema->resultset('ExtAPK')->create({}); - for my $id (@eapk_id_columns) { + $new = $schema->resultset('ExtAPK')->create({ id1 => 1}); + my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"}; + is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" ) + or eapk_seq_diag($s,$schema_name); + $new->discard_changes; + is( $new->id1, 1 ); + for my $id ('id3','id4') { my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"}; - is( $new->$id, $proper_seqval, "correct $id inc $inc" ) - or eapk_seq_diag($s); + is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" ) + or eapk_seq_diag($s,$schema_name); } } } "create in schema '$schema_name' lives" - or eapk_seq_diag($s); + or eapk_seq_diag($s,$schema_name); } # print diagnostic info on which sequences were found in the ExtAPK # class sub eapk_seq_diag { my $s = shift; - my $schema = shift || $s->storage->dbh_do('_get_pg_search_path')->[0]; + my $schema = shift || eapk_find_visible_schema($s); diag "$schema.apk sequences: ", join(', ', @@ -586,6 +665,25 @@ sub eapk_seq_diag { ); } +# get the postgres search path as an arrayref +sub eapk_get_search_path { + my ( $s ) = @_; + # cache the search path as ['schema','schema',...] in the storage + # obj + + return $s->storage->dbh_do(sub { + my (undef, $dbh) = @_; + my @search_path; + my ($sp_string) = $dbh->selectrow_array('SHOW search_path'); + while ( $sp_string =~ s/("[^"]+"|[^,]+),?// ) { + unless( defined $1 and length $1 ) { + die "search path sanity check failed: '$1'"; + } + push @search_path, $1; + } + \@search_path + }); +} sub eapk_set_search_path { my ($s,@sp) = @_; my $sp = join ',',@sp; @@ -614,13 +712,13 @@ sub eapk_create { local $_[1]->{Warn} = 0; my $id_def = $a{nextval} - ? "integer primary key not null default nextval('$a{nextval}'::regclass)" - : 'serial primary key'; + ? "integer not null default nextval('$a{nextval}'::regclass)" + : 'serial'; $dbh->do(<storage->dbh_do(sub { my (undef,$dbh) = @_; @@ -642,9 +740,25 @@ sub eapk_drop_all { # drop the test schemas for (@eapk_schemas ) { eval{ $dbh->do("DROP SCHEMA $_ CASCADE") }; - diag $@ if $@ && !$no_warn; + diag $@ if $@ && $warn_exceptions; } }); } + +sub eapk_find_visible_schema { + my ($s) = @_; + + my ($schema) = + $s->storage->dbh_do(sub { + $_[1]->selectrow_array(<