1use strict; 2use warnings; 3 4use Test::More; 5use Test::Exception; 6use lib qw(t/lib); 7use DBICTest; 8 9 10my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/}; 11 12plan skip_all => <<EOM unless $dsn && $user; 13Set \$ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test 14( NOTE: This test drops and creates tables called 'artist', 'casecheck', 15 'array_test' and 'sequence_test' as well as following sequences: 16 'pkid1_seq', 'pkid2_seq' and 'nonpkid_seq''. as well as following 17 schemas: 'dbic_t_schema', 'dbic_t_schema_2', 'dbic_t_schema_3', 18 'dbic_t_schema_4', and 'dbic_t_schema_5' 19) 20EOM 21 22### load any test classes that are defined further down in the file via BEGIN blocks 23 24our @test_classes; #< array that will be pushed into by test classes defined in this file 25DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes; 26 27 28### pre-connect tests (keep each test separate as to make sure rebless() runs) 29{ 30 my $s = DBICTest::Schema->connect($dsn, $user, $pass); 31 32 ok (!$s->storage->_dbh, 'definitely not connected'); 33 34 # Check that datetime_parser returns correctly before we explicitly connect. 35 SKIP: { 36 eval { require DateTime::Format::Pg }; 37 skip "DateTime::Format::Pg required", 2 if $@; 38 39 my $store = ref $s->storage; 40 is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage'); 41 42 my $parser = $s->storage->datetime_parser; 43 is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected'); 44 } 45 46 ok (!$s->storage->_dbh, 'still not connected'); 47} 48{ 49 my $s = DBICTest::Schema->connect($dsn, $user, $pass); 50 # make sure sqlt_type overrides work (::Storage::DBI::Pg does this) 51 ok (!$s->storage->_dbh, 'definitely not connected'); 52 is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection'); 53 ok (!$s->storage->_dbh, 'still not connected'); 54} 55 56### connect, create postgres-specific test schema 57 58my $schema = DBICTest::Schema->connect($dsn, $user, $pass); 59 60drop_test_schema($schema); 61create_test_schema($schema); 62 63### begin main tests 64 65 66# run a BIG bunch of tests for last-insert-id / Auto-PK / sequence 67# discovery 68run_apk_tests($schema); #< older set of auto-pk tests 69run_extended_apk_tests($schema); #< new extended set of auto-pk tests 70 71 72 73 74 75### type_info tests 76 77my $test_type_info = { 78 'artistid' => { 79 'data_type' => 'integer', 80 'is_nullable' => 0, 81 'size' => 4, 82 }, 83 'name' => { 84 'data_type' => 'character varying', 85 'is_nullable' => 1, 86 'size' => 100, 87 'default_value' => undef, 88 }, 89 'rank' => { 90 'data_type' => 'integer', 91 'is_nullable' => 0, 92 'size' => 4, 93 'default_value' => 13, 94 95 }, 96 'charfield' => { 97 'data_type' => 'character', 98 'is_nullable' => 1, 99 'size' => 10, 100 'default_value' => undef, 101 }, 102 'arrayfield' => { 103 'data_type' => 'integer[]', 104 'is_nullable' => 1, 105 'size' => undef, 106 'default_value' => undef, 107 }, 108}; 109 110my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist'); 111my $artistid_defval = delete $type_info->{artistid}->{default_value}; 112like($artistid_defval, 113 qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/, 114 'columns_info_for - sequence matches Pg get_autoinc_seq expectations'); 115is_deeply($type_info, $test_type_info, 116 'columns_info_for - column data types'); 117 118 119 120 121####### Array tests 122 123BEGIN { 124 package DBICTest::Schema::ArrayTest; 125 push @main::test_classes, __PACKAGE__; 126 127 use strict; 128 use warnings; 129 use base 'DBIx::Class::Core'; 130 131 __PACKAGE__->table('dbic_t_schema.array_test'); 132 __PACKAGE__->add_columns(qw/id arrayfield/); 133 __PACKAGE__->column_info_from_storage(1); 134 __PACKAGE__->set_primary_key('id'); 135 136} 137SKIP: { 138 skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002; 139 140 lives_ok { 141 $schema->resultset('ArrayTest')->create({ 142 arrayfield => [1, 2], 143 }); 144 } 'inserting arrayref as pg array data'; 145 146 lives_ok { 147 $schema->resultset('ArrayTest')->update({ 148 arrayfield => [3, 4], 149 }); 150 } 'updating arrayref as pg array data'; 151 152 $schema->resultset('ArrayTest')->create({ 153 arrayfield => [5, 6], 154 }); 155 156 my $count; 157 lives_ok { 158 $count = $schema->resultset('ArrayTest')->search({ 159 arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ], #Todo anything less ugly than this? 160 })->count; 161 } 'comparing arrayref to pg array data does not blow up'; 162 is($count, 1, 'comparing arrayref to pg array data gives correct result'); 163} 164 165 166 167########## Case check 168 169BEGIN { 170 package DBICTest::Schema::Casecheck; 171 push @main::test_classes, __PACKAGE__; 172 173 use strict; 174 use warnings; 175 use base 'DBIx::Class::Core'; 176 177 __PACKAGE__->table('dbic_t_schema.casecheck'); 178 __PACKAGE__->add_columns(qw/id name NAME uc_name/); 179 __PACKAGE__->column_info_from_storage(1); 180 __PACKAGE__->set_primary_key('id'); 181} 182 183my $name_info = $schema->source('Casecheck')->column_info( 'name' ); 184is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" ); 185 186my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' ); 187is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" ); 188 189my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' ); 190is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" ); 191 192 193 194 195## Test SELECT ... FOR UPDATE 196 197SKIP: { 198 if(eval "require Sys::SigAction" && !$@) { 199 Sys::SigAction->import( 'set_sig_handler' ); 200 } 201 else { 202 skip "Sys::SigAction is not available", 6; 203 } 204 205 my ($timed_out, $artist2); 206 207 for my $t ( 208 { 209 # Make sure that an error was raised, and that the update failed 210 update_lock => 1, 211 test_sub => sub { 212 ok($timed_out, "update from second schema times out"); 213 ok($artist2->is_column_changed('name'), "'name' column is still dirty from second schema"); 214 }, 215 }, 216 { 217 # Make sure that an error was NOT raised, and that the update succeeded 218 update_lock => 0, 219 test_sub => sub { 220 ok(! $timed_out, "update from second schema DOES NOT timeout"); 221 ok(! $artist2->is_column_changed('name'), "'name' column is NOT dirty from second schema"); 222 }, 223 }, 224 ) { 225 # create a new schema 226 my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass); 227 $schema2->source("Artist")->name("dbic_t_schema.artist"); 228 229 $schema->txn_do( sub { 230 my $artist = $schema->resultset('Artist')->search( 231 { 232 artistid => 1 233 }, 234 $t->{update_lock} ? { for => 'update' } : {} 235 )->first; 236 is($artist->artistid, 1, "select returns artistid = 1"); 237 238 $timed_out = 0; 239 eval { 240 my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } ); 241 alarm(2); 242 $artist2 = $schema2->resultset('Artist')->find(1); 243 $artist2->name('fooey'); 244 $artist2->update; 245 alarm(0); 246 }; 247 $timed_out = $@ =~ /DBICTestTimeout/; 248 }); 249 250 $t->{test_sub}->(); 251 } 252} 253 254 255######## other older Auto-pk tests 256 257$schema->source("SequenceTest")->name("dbic_t_schema.sequence_test"); 258for (1..5) { 259 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); 260 is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key"); 261 is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key"); 262 is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key"); 263} 264my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); 265is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); 266 267done_testing; 268 269exit; 270 271END { 272 return unless $schema; 273 drop_test_schema($schema); 274 eapk_drop_all( $schema) 275}; 276 277 278######### SUBROUTINES 279 280sub create_test_schema { 281 my $schema = shift; 282 $schema->storage->dbh_do(sub { 283 my (undef,$dbh) = @_; 284 285 local $dbh->{Warn} = 0; 286 287 my $std_artist_table = <<EOS; 288( 289 artistid serial PRIMARY KEY 290 , name VARCHAR(100) 291 , rank INTEGER NOT NULL DEFAULT '13' 292 , charfield CHAR(10) 293 , arrayfield INTEGER[] 294) 295EOS 296 297 $dbh->do("CREATE SCHEMA dbic_t_schema"); 298 $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table"); 299 $dbh->do(<<EOS); 300CREATE TABLE dbic_t_schema.sequence_test ( 301 pkid1 integer 302 , pkid2 integer 303 , nonpkid integer 304 , name VARCHAR(100) 305 , CONSTRAINT pk PRIMARY KEY(pkid1, pkid2) 306) 307EOS 308 $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0"); 309 $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0"); 310 $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0"); 311 $dbh->do(<<EOS); 312CREATE TABLE dbic_t_schema.casecheck ( 313 id serial PRIMARY KEY 314 , "name" VARCHAR(1) 315 , "NAME" VARCHAR(2) 316 , "UC_NAME" VARCHAR(3) 317) 318EOS 319 $dbh->do(<<EOS); 320CREATE TABLE dbic_t_schema.array_test ( 321 id serial PRIMARY KEY 322 , arrayfield INTEGER[] 323) 324EOS 325 $dbh->do("CREATE SCHEMA dbic_t_schema_2"); 326 $dbh->do("CREATE TABLE dbic_t_schema_2.artist $std_artist_table"); 327 $dbh->do("CREATE SCHEMA dbic_t_schema_3"); 328 $dbh->do("CREATE TABLE dbic_t_schema_3.artist $std_artist_table"); 329 $dbh->do('set search_path=dbic_t_schema,public'); 330 $dbh->do("CREATE SCHEMA dbic_t_schema_4"); 331 $dbh->do("CREATE SCHEMA dbic_t_schema_5"); 332 $dbh->do(<<EOS); 333 CREATE TABLE dbic_t_schema_4.artist 334 ( 335 artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY 336 , name VARCHAR(100) 337 , rank INTEGER NOT NULL DEFAULT '13' 338 , charfield CHAR(10) 339 , arrayfield INTEGER[] 340 ); 341EOS 342 $dbh->do('set search_path=public,dbic_t_schema,dbic_t_schema_3'); 343 $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema 344 $dbh->do(<<EOS); 345 CREATE TABLE dbic_t_schema_5.artist 346 ( 347 artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY 348 , name VARCHAR(100) 349 , rank INTEGER NOT NULL DEFAULT '13' 350 , charfield CHAR(10) 351 , arrayfield INTEGER[] 352 ); 353EOS 354 $dbh->do('set search_path=dbic_t_schema,public'); 355 }); 356} 357 358 359 360sub drop_test_schema { 361 my ( $schema, $warn_exceptions ) = @_; 362 363 $schema->storage->dbh_do(sub { 364 my (undef,$dbh) = @_; 365 366 local $dbh->{Warn} = 0; 367 368 for my $stat ( 369 'DROP SCHEMA dbic_t_schema_5 CASCADE', 370 'DROP SEQUENCE public.artist_artistid_seq', 371 'DROP SCHEMA dbic_t_schema_4 CASCADE', 372 'DROP SCHEMA dbic_t_schema CASCADE', 373 'DROP SEQUENCE pkid1_seq', 374 'DROP SEQUENCE pkid2_seq', 375 'DROP SEQUENCE nonpkid_seq', 376 'DROP SCHEMA dbic_t_schema_2 CASCADE', 377 'DROP SCHEMA dbic_t_schema_3 CASCADE', 378 ) { 379 eval { $dbh->do ($stat) }; 380 diag $@ if $@ && $warn_exceptions; 381 } 382 }); 383} 384 385 386### auto-pk / last_insert_id / sequence discovery 387sub run_apk_tests { 388 my $schema = shift; 389 390 # This is in Core now, but it's here just to test that it doesn't break 391 $schema->class('Artist')->load_components('PK::Auto'); 392 cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table'); 393 394 # test that auto-pk also works with the defined search path by 395 # un-schema-qualifying the table name 396 apk_t_set($schema,'artist'); 397 398 my $unq_new; 399 lives_ok { 400 $unq_new = $schema->resultset('Artist')->create({ name => 'baz' }); 401 } 'insert into unqualified, shadowed table succeeds'; 402 403 is($unq_new && $unq_new->artistid, 1, "and got correct artistid"); 404 405 my @test_schemas = ( [qw| dbic_t_schema_2 1 |], 406 [qw| dbic_t_schema_3 1 |], 407 [qw| dbic_t_schema_4 2 |], 408 [qw| dbic_t_schema_5 1 |], 409 ); 410 foreach my $t ( @test_schemas ) { 411 my ($sch_name, $start_num) = @$t; 412 #test with dbic_t_schema_2 413 apk_t_set($schema,"$sch_name.artist"); 414 my $another_new; 415 lives_ok { 416 $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'}); 417 is( $another_new->artistid,$start_num, "got correct artistid for $sch_name") 418 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>'); 419 } "$sch_name liid 1 did not die" 420 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>'); 421 lives_ok { 422 $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'}); 423 is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name") 424 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>'); 425 } "$sch_name liid 2 did not die" 426 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>'); 427 428 } 429 430 lives_ok { 431 apk_t_set($schema,'dbic_t_schema.artist'); 432 my $new = $schema->resultset('Artist')->create({ name => 'foo' }); 433 is($new->artistid, 4, "Auto-PK worked"); 434 $new = $schema->resultset('Artist')->create({ name => 'bar' }); 435 is($new->artistid, 5, "Auto-PK worked"); 436 } 'old auto-pk tests did not die either'; 437} 438 439# sets the artist table name and clears sequence name cache 440sub apk_t_set { 441 my ( $s, $n ) = @_; 442 $s->source("Artist")->name($n); 443 $s->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache 444} 445 446 447######## EXTENDED AUTO-PK TESTS 448 449my @eapk_id_columns; 450BEGIN { 451 package DBICTest::Schema::ExtAPK; 452 push @main::test_classes, __PACKAGE__; 453 454 use strict; 455 use warnings; 456 use base 'DBIx::Class::Core'; 457 458 __PACKAGE__->table('apk'); 459 460 @eapk_id_columns = qw( id1 id2 id3 id4 ); 461 __PACKAGE__->add_columns( 462 map { $_ => { data_type => 'integer', is_auto_increment => 1 } } 463 @eapk_id_columns 464 ); 465 466 __PACKAGE__->set_primary_key('id2'); #< note the SECOND column is 467 #the primary key 468} 469 470my @eapk_schemas; 471BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 } 472my %seqs; #< hash of schema.table.col => currval of its (DBIC) primary key sequence 473 474sub run_extended_apk_tests { 475 my $schema = shift; 476 477 #save the search path and reset it at the end 478 my $search_path_save = eapk_get_search_path($schema); 479 480 eapk_drop_all($schema); 481 482 # make the test schemas and sequences 483 $schema->storage->dbh_do(sub { 484 my ( undef, $dbh ) = @_; 485 486 $dbh->do("CREATE SCHEMA $_") 487 for @eapk_schemas; 488 489 $dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq"); 490 $dbh->do("SELECT setval('$eapk_schemas[5].fooseq',400)"); 491 $seqs{"$eapk_schemas[1].apk.id2"} = 400; 492 493 $dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq"); 494 $dbh->do("SELECT setval('$eapk_schemas[4].fooseq',300)"); 495 $seqs{"$eapk_schemas[3].apk.id2"} = 300; 496 497 $dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq"); 498 $dbh->do("SELECT setval('$eapk_schemas[3].fooseq',200)"); 499 $seqs{"$eapk_schemas[4].apk.id2"} = 200; 500 501 $dbh->do("SET search_path = ".join ',', reverse @eapk_schemas ); 502 }); 503 504 # clear our search_path cache 505 $schema->storage->{_pg_search_path} = undef; 506 507 eapk_create( $schema, 508 with_search_path => [0,1], 509 ); 510 eapk_create( $schema, 511 with_search_path => [1,0,'public'], 512 nextval => "$eapk_schemas[5].fooseq", 513 ); 514 eapk_create( $schema, 515 with_search_path => ['public',0,1], 516 qualify_table => 2, 517 ); 518 eapk_create( $schema, 519 with_search_path => [3,1,0,'public'], 520 nextval => "$eapk_schemas[4].fooseq", 521 ); 522 eapk_create( $schema, 523 with_search_path => [3,1,0,'public'], 524 nextval => "$eapk_schemas[3].fooseq", 525 qualify_table => 4, 526 ); 527 528 eapk_poke( $schema ); 529 eapk_poke( $schema, 0 ); 530 eapk_poke( $schema, 2 ); 531 eapk_poke( $schema, 4 ); 532 eapk_poke( $schema, 1 ); 533 eapk_poke( $schema, 0 ); 534 eapk_poke( $schema, 1 ); 535 eapk_poke( $schema ); 536 eapk_poke( $schema, 4 ); 537 eapk_poke( $schema, 3 ); 538 eapk_poke( $schema, 1 ); 539 eapk_poke( $schema, 2 ); 540 eapk_poke( $schema, 0 ); 541 542 # set our search path back 543 eapk_set_search_path( $schema, @$search_path_save ); 544} 545 546# do a DBIC create on the apk table in the given schema number (which is an 547# index of @eapk_schemas) 548 549sub eapk_poke { 550 my ($s, $schema_num) = @_; 551 552 my $schema_name = defined $schema_num 553 ? $eapk_schemas[$schema_num] 554 : ''; 555 556 my $schema_name_actual = $schema_name || eapk_find_visible_schema($s); 557 558 $s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk'); 559 #< clear sequence name cache 560 $s->source('ExtAPK')->column_info($_)->{sequence} = undef 561 for @eapk_id_columns; 562 563 no warnings 'uninitialized'; 564 lives_ok { 565 my $new; 566 for my $inc (1,2,3) { 567 $new = $schema->resultset('ExtAPK')->create({ id1 => 1}); 568 my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"}; 569 is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" ) 570 or eapk_seq_diag($s,$schema_name); 571 $new->discard_changes; 572 is( $new->id1, 1 ); 573 for my $id ('id3','id4') { 574 my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"}; 575 is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" ) 576 or eapk_seq_diag($s,$schema_name); 577 } 578 } 579 } "create in schema '$schema_name' lives" 580 or eapk_seq_diag($s,$schema_name); 581} 582 583# print diagnostic info on which sequences were found in the ExtAPK 584# class 585sub eapk_seq_diag { 586 my $s = shift; 587 my $schema = shift || eapk_find_visible_schema($s); 588 589 diag "$schema.apk sequences: ", 590 join(', ', 591 map "$_:".($s->source('ExtAPK')->column_info($_)->{sequence} || '<none>'), 592 @eapk_id_columns 593 ); 594} 595 596# get the postgres search path as an arrayref 597sub eapk_get_search_path { 598 my ( $s ) = @_; 599 # cache the search path as ['schema','schema',...] in the storage 600 # obj 601 602 return $s->storage->dbh_do(sub { 603 my (undef, $dbh) = @_; 604 my @search_path; 605 my ($sp_string) = $dbh->selectrow_array('SHOW search_path'); 606 while ( $sp_string =~ s/("[^"]+"|[^,]+),?// ) { 607 unless( defined $1 and length $1 ) { 608 die "search path sanity check failed: '$1'"; 609 } 610 push @search_path, $1; 611 } 612 \@search_path 613 }); 614} 615sub eapk_set_search_path { 616 my ($s,@sp) = @_; 617 my $sp = join ',',@sp; 618 $s->storage->dbh_do( sub { $_[1]->do("SET search_path = $sp") } ); 619} 620 621# create the apk table in the given schema, can set whether the table name is qualified, what the nextval is for the second ID 622sub eapk_create { 623 my ($schema, %a) = @_; 624 625 $schema->storage->dbh_do(sub { 626 my (undef,$dbh) = @_; 627 628 my $searchpath_save; 629 if ( $a{with_search_path} ) { 630 ($searchpath_save) = $dbh->selectrow_array('SHOW search_path'); 631 632 my $search_path = join ',',map {/\D/ ? $_ : $eapk_schemas[$_]} @{$a{with_search_path}}; 633 634 $dbh->do("SET search_path = $search_path"); 635 } 636 637 my $table_name = $a{qualify_table} 638 ? ($eapk_schemas[$a{qualify_table}] || die). ".apk" 639 : 'apk'; 640 local $_[1]->{Warn} = 0; 641 642 my $id_def = $a{nextval} 643 ? "integer not null default nextval('$a{nextval}'::regclass)" 644 : 'serial'; 645 $dbh->do(<<EOS); 646CREATE TABLE $table_name ( 647 id1 serial 648 , id2 $id_def 649 , id3 serial primary key 650 , id4 serial 651) 652EOS 653 654 if( $searchpath_save ) { 655 $dbh->do("SET search_path = $searchpath_save"); 656 } 657 }); 658} 659 660sub eapk_drop_all { 661 my ( $schema, $warn_exceptions ) = @_; 662 663 $schema->storage->dbh_do(sub { 664 my (undef,$dbh) = @_; 665 666 local $dbh->{Warn} = 0; 667 668 # drop the test schemas 669 for (@eapk_schemas ) { 670 eval{ $dbh->do("DROP SCHEMA $_ CASCADE") }; 671 diag $@ if $@ && $warn_exceptions; 672 } 673 674 675 }); 676} 677 678sub eapk_find_visible_schema { 679 my ($s) = @_; 680 681 my ($schema) = 682 $s->storage->dbh_do(sub { 683 $_[1]->selectrow_array(<<EOS); 684SELECT n.nspname 685FROM pg_catalog.pg_namespace n 686JOIN pg_catalog.pg_class c ON c.relnamespace = n.oid 687WHERE c.relname = 'apk' 688 AND pg_catalog.pg_table_is_visible(c.oid) 689EOS 690 }); 691 return $schema; 692} 693