t/72pg.t

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