Only load DBICTest::Schema when needed in tests
[dbsrgits/DBIx-Class.git] / t / 72pg.t
CommitLineData
70350518 1use strict;
4617b792 2use warnings;
70350518 3
4use Test::More;
9ba627e3 5use Test::Exception;
bbdda281 6use Sub::Name;
bb961936 7use Config;
199fbc45 8use DBIx::Class::Optional::Dependencies ();
70350518 9use lib qw(t/lib);
10use DBICTest;
b5ce6748 11use SQL::Abstract 'is_literal_value';
bb961936 12use DBIx::Class::_Util 'is_exception';
70350518 13
199fbc45 14plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_pg')
15 unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_pg');
89add887 16
0567538f 17my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
18
67b79ae1 19plan skip_all => <<'EOM' unless $dsn && $user;
20Set $ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test
bab40dee 21( NOTE: This test drops and creates tables called 'artist', 'cd',
22'timestamp_primary_key_test', 'track', 'casecheck', 'array_test' and
23'sequence_test' as well as following sequences: 'pkid1_seq', 'pkid2_seq' and
67b79ae1 24'nonpkid_seq'. as well as following schemas: 'dbic_t_schema',
bab40dee 25'dbic_t_schema_2', 'dbic_t_schema_3', 'dbic_t_schema_4', and 'dbic_t_schema_5')
609c5f1b 26EOM
0567538f 27
52c53388 28### load any test classes that are defined further down in the file via BEGIN blocks
efd38994 29
70a201a5 30our @test_classes; #< array that will be pushed into by test classes defined in this file
2c2bc4e5 31require DBICTest::Schema;
70a201a5 32DBICTest::Schema->load_classes( map {s/.+:://;$_} @test_classes ) if @test_classes;
efd38994 33
52c53388 34### pre-connect tests (keep each test separate as to make sure rebless() runs)
bab40dee 35 {
2c2bc4e5 36 my $s = DBICTest->connect_schema($dsn, $user, $pass);
eabde904 37
bab40dee 38 ok (!$s->storage->_dbh, 'definitely not connected');
eabde904 39
bab40dee 40 # Check that datetime_parser returns correctly before we explicitly connect.
41 SKIP: {
68de9438 42 skip (
43 "Pg parser detection test needs " . DBIx::Class::Optional::Dependencies->req_missing_for ('test_dt_pg'),
44 2
45 ) unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_dt_pg');
114780ee 46
bab40dee 47 my $store = ref $s->storage;
48 is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');
114780ee 49
bab40dee 50 my $parser = $s->storage->datetime_parser;
51 is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
52 }
114780ee 53
bab40dee 54 ok (!$s->storage->_dbh, 'still not connected');
55 }
bbdda281 56
bab40dee 57 {
2c2bc4e5 58 my $s = DBICTest->connect_schema($dsn, $user, $pass);
bab40dee 59 # make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
60 ok (!$s->storage->_dbh, 'definitely not connected');
61 is ($s->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
62 ok (!$s->storage->_dbh, 'still not connected');
63 }
0567538f 64
97277745 65# test LIMIT support
66{
2c2bc4e5 67 my $schema = DBICTest->connect_schema($dsn, $user, $pass);
97277745 68 drop_test_schema($schema);
69 create_test_schema($schema);
70 for (1..6) {
71 $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
72 }
73 my $it = $schema->resultset('Artist')->search( {},
74 { rows => 3,
75 offset => 2,
76 order_by => 'artistid' }
77 );
78 is( $it->count, 3, "LIMIT count ok" ); # ask for 3 rows out of 6 artists
79 is( $it->next->name, "Artist 3", "iterator->next ok" );
80 $it->next;
81 $it->next;
82 $it->next;
83 is( $it->next, undef, "next past end of resultset ok" );
e5372da4 84
85 # Limit with select-lock
86 lives_ok {
87 $schema->txn_do (sub {
88 isa_ok (
89 $schema->resultset('Artist')->find({artistid => 1}, {for => 'update', rows => 1}),
90 'DBICTest::Schema::Artist',
91 );
92 });
93 } 'Limited FOR UPDATE select works';
97277745 94}
95
bbdda281 96# check if we indeed do support stuff
97my $test_server_supports_insert_returning = do {
af1f4f84 98
2c2bc4e5 99 my $si = DBICTest->connect_schema($dsn, $user, $pass)->storage->_server_info;
af1f4f84 100 die "Unparseable Pg server version: $si->{dbms_version}\n"
101 unless $si->{normalized_dbms_version};
102
103 $si->{normalized_dbms_version} < 8.002 ? 0 : 1;
bbdda281 104};
105is (
2c2bc4e5 106 DBICTest->connect_schema($dsn, $user, $pass)->storage->_use_insert_returning,
bbdda281 107 $test_server_supports_insert_returning,
108 'insert returning capability guessed correctly'
109);
110
111my $schema;
112for my $use_insert_returning ($test_server_supports_insert_returning
113 ? (0,1)
114 : (0)
115) {
116
6892eb09 117 no warnings qw/once redefine/;
118 my $old_connection = DBICTest::Schema->can('connection');
bbdda281 119 local *DBICTest::Schema::connection = subname 'DBICTest::Schema::connection' => sub {
6892eb09 120 my $s = shift->$old_connection(@_);
bbdda281 121 $s->storage->_use_insert_returning ($use_insert_returning);
122 $s;
123 };
124
125### test capability override
126 {
2c2bc4e5 127 my $s = DBICTest->connect_schema($dsn, $user, $pass);
bbdda281 128
129 ok (!$s->storage->_dbh, 'definitely not connected');
130
131 ok (
132 ! ($s->storage->_use_insert_returning xor $use_insert_returning),
133 'insert returning capability set correctly',
134 );
135 ok (!$s->storage->_dbh, 'still not connected (capability override works)');
136 }
137
70a201a5 138### connect, create postgres-specific test schema
c3af542a 139
2c2bc4e5 140 $schema = DBICTest->connect_schema($dsn, $user, $pass);
1f5aae08 141 $schema->storage->ensure_connected;
142
bab40dee 143 drop_test_schema($schema);
144 create_test_schema($schema);
609c5f1b 145
70a201a5 146### begin main tests
4617b792 147
372da819 148# run a BIG bunch of tests for last-insert-id / Auto-PK / sequence
149# discovery
bab40dee 150 run_apk_tests($schema); #< older set of auto-pk tests
151 run_extended_apk_tests($schema); #< new extended set of auto-pk tests
70a201a5 152
bab40dee 153### type_info tests
52c53388 154
bab40dee 155 my $test_type_info = {
156 'artistid' => {
157 'data_type' => 'integer',
158 'is_nullable' => 0,
159 'size' => 4,
160 },
161 'name' => {
162 'data_type' => 'character varying',
163 'is_nullable' => 1,
164 'size' => 100,
165 'default_value' => undef,
166 },
167 'rank' => {
168 'data_type' => 'integer',
169 'is_nullable' => 0,
170 'size' => 4,
171 'default_value' => 13,
52c53388 172
bab40dee 173 },
174 'charfield' => {
175 'data_type' => 'character',
176 'is_nullable' => 1,
177 'size' => 10,
178 'default_value' => undef,
179 },
180 'arrayfield' => {
181 'data_type' => 'integer[]',
182 'is_nullable' => 1,
183 'size' => undef,
184 'default_value' => undef,
185 },
186 };
52c53388 187
bab40dee 188 my $type_info = $schema->storage->columns_info_for('dbic_t_schema.artist');
189 my $artistid_defval = delete $type_info->{artistid}->{default_value};
190 like($artistid_defval,
191 qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
192 'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
193 is_deeply($type_info, $test_type_info,
194 'columns_info_for - column data types');
52c53388 195
70a201a5 196
a953d8d9 197
a953d8d9 198
bab40dee 199####### Array tests
70a201a5 200
bab40dee 201 BEGIN {
202 package DBICTest::Schema::ArrayTest;
203 push @main::test_classes, __PACKAGE__;
70a201a5 204
bab40dee 205 use strict;
206 use warnings;
41519379 207 use base 'DBICTest::BaseResult';
70a201a5 208
bab40dee 209 __PACKAGE__->table('dbic_t_schema.array_test');
210 __PACKAGE__->add_columns(qw/id arrayfield/);
211 __PACKAGE__->column_info_from_storage(1);
212 __PACKAGE__->set_primary_key('id');
70a201a5 213
bab40dee 214 }
215 SKIP: {
0647e0cc 216 skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
70a201a5 217
41519379 218 my $arr_rs = $schema->resultset('ArrayTest');
219
bab40dee 220 lives_ok {
41519379 221 $arr_rs->create({
bab40dee 222 arrayfield => [1, 2],
223 });
224 } 'inserting arrayref as pg array data';
70a201a5 225
bab40dee 226 lives_ok {
41519379 227 $arr_rs->update({
bab40dee 228 arrayfield => [3, 4],
229 });
230 } 'updating arrayref as pg array data';
ac45262b 231
41519379 232 $arr_rs->create({
0647e0cc 233 arrayfield => [5, 6],
9ba627e3 234 });
c224117b 235
f6faeab8 236 lives_ok {
237 $schema->populate('ArrayTest', [
238 [ qw/arrayfield/ ],
239 [ [0,0] ],
240 ]);
241 } 'inserting arrayref using void ctx populate';
242
41519379 243 # Search using arrays
244 lives_ok {
245 is_deeply (
246 $arr_rs->search({ arrayfield => { -value => [3,4] } })->first->arrayfield,
247 [3,4],
248 'Array value matches'
249 );
250 } 'searching by arrayref';
a780a0ff 251
bab40dee 252 lives_ok {
41519379 253 is_deeply (
254 $arr_rs->search({ arrayfield => { '=' => { -value => [3,4] }} })->first->arrayfield,
49eeb48d 255 [3,4],
41519379 256 'Array value matches explicit equal'
257 );
258 } 'searching by arrayref (explicit equal sign)';
a780a0ff 259
41519379 260 lives_ok {
261 is_deeply (
262 $arr_rs->search({ arrayfield => { '>' => { -value => [3,1] }} })->first->arrayfield,
263 [3,4],
264 'Array value matches greater than'
265 );
266 } 'searching by arrayref (greater than)';
267
268 lives_ok {
269 is (
270 $arr_rs->search({ arrayfield => { '>' => { -value => [3,7] }} })->count,
271 1,
272 'Greater than search found [5,6]',
273 );
274 } 'searching by arrayref (greater than)';
275
276 # Find using arrays
277 lives_ok {
278 is_deeply (
279 $arr_rs->find({ arrayfield => { -value => [3,4] } })->arrayfield,
280 [3,4],
281 'Array value matches implicit equal'
282 );
283 } 'find by arrayref';
284
285 lives_ok {
286 is_deeply (
287 $arr_rs->find({ arrayfield => { '=' => { -value => [3,4] }} })->arrayfield,
288 [3,4],
289 'Array value matches explicit equal'
290 );
291 } 'find by arrayref (equal)';
292
293 # test inferred condition for creation
4ca1fd6f 294 for my $cond (
41519379 295 { -value => [3,4] },
296 \[ '= ?' => [arrayfield => [3, 4]] ],
297 ) {
5f35ba0f 298 local $TODO = 'No introspection of complex literal conditions :('
299 if is_literal_value $cond;
300
301
41519379 302 my $arr_rs_cond = $arr_rs->search({ arrayfield => $cond });
303
304 my $row = $arr_rs_cond->create({});
a780a0ff 305 is_deeply ($row->arrayfield, [3,4], 'Array value taken from $rs condition');
306 $row->discard_changes;
307 is_deeply ($row->arrayfield, [3,4], 'Array value made it to storage');
308 }
bab40dee 309 }
9ba627e3 310
70a201a5 311########## Case check
312
bab40dee 313 BEGIN {
314 package DBICTest::Schema::Casecheck;
315 push @main::test_classes, __PACKAGE__;
70a201a5 316
bab40dee 317 use strict;
318 use warnings;
319 use base 'DBIx::Class::Core';
70a201a5 320
bab40dee 321 __PACKAGE__->table('dbic_t_schema.casecheck');
322 __PACKAGE__->add_columns(qw/id name NAME uc_name/);
323 __PACKAGE__->column_info_from_storage(1);
324 __PACKAGE__->set_primary_key('id');
325 }
70a201a5 326
bab40dee 327 my $name_info = $schema->source('Casecheck')->column_info( 'name' );
328 is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
ae515736 329
bab40dee 330 my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' );
331 is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" );
ae515736 332
bab40dee 333 my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
334 is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
ae515736 335
70a201a5 336
ecccae8a 337## Test ResultSet->update
338my $artist = $schema->resultset('Artist')->first;
339my $cds = $artist->cds_unordered->search({
340 year => { '!=' => 2010 }
341}, { prefetch => 'liner_notes' });
67b79ae1 342lives_ok { $cds->update({ year => '2010' }) } 'Update on prefetched rs';
70a201a5 343
344## Test SELECT ... FOR UPDATE
bab40dee 345 SKIP: {
bb961936 346 skip "Your system does not support unsafe signals (d_sigaction) - unable to run deadlock test", 1
347 unless eval { $Config{d_sigaction} and require POSIX };
bab40dee 348
349 my ($timed_out, $artist2);
350
351 for my $t (
352 {
353 # Make sure that an error was raised, and that the update failed
354 update_lock => 1,
355 test_sub => sub {
356 ok($timed_out, "update from second schema times out");
357 ok($artist2->is_column_changed('name'), "'name' column is still dirty from second schema");
358 },
52c53388 359 },
bab40dee 360 {
361 # Make sure that an error was NOT raised, and that the update succeeded
362 update_lock => 0,
363 test_sub => sub {
364 ok(! $timed_out, "update from second schema DOES NOT timeout");
365 ok(! $artist2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
366 },
52c53388 367 },
bab40dee 368 ) {
369 # create a new schema
2c2bc4e5 370 my $schema2 = DBICTest->connect_schema($dsn, $user, $pass);
bab40dee 371 $schema2->source("Artist")->name("dbic_t_schema.artist");
372
373 $schema->txn_do( sub {
d2408067 374 my $rs = $schema->resultset('Artist')->search(
bab40dee 375 {
376 artistid => 1
377 },
378 $t->{update_lock} ? { for => 'update' } : {}
d2408067 379 );
380 ok ($rs->count, 'Count works');
381
382 my $artist = $rs->next;
bab40dee 383 is($artist->artistid, 1, "select returns artistid = 1");
384
385 $timed_out = 0;
bb961936 386
bab40dee 387 eval {
bb961936 388 # can not use %SIG assignment directly - we need sigaction below
389 # localization to a block still works however
390 local $SIG{ALRM};
391
392 POSIX::sigaction( POSIX::SIGALRM() => POSIX::SigAction->new(
393 sub { die "DBICTestTimeout" },
394 ));
395
bab40dee 396 alarm(2);
397 $artist2 = $schema2->resultset('Artist')->find(1);
398 $artist2->name('fooey');
399 $artist2->update;
bab40dee 400 };
bb961936 401
402 alarm(0);
403
404 if (is_exception($@)) {
405 $timed_out = $@ =~ /DBICTestTimeout/
406 or die $@;
407 }
bab40dee 408 });
409
410 $t->{test_sub}->();
411 }
412 }
95ba7ee4 413
70a201a5 414
372da819 415######## other older Auto-pk tests
70a201a5 416
bab40dee 417 $schema->source("SequenceTest")->name("dbic_t_schema.sequence_test");
418 for (1..5) {
419 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
420 is($st->pkid1, $_, "Auto-PK for sequence without default: First primary key");
421 is($st->pkid2, $_ + 9, "Auto-PK for sequence without default: Second primary key");
422 is($st->nonpkid, $_ + 19, "Auto-PK for sequence without default: Non-primary key");
423 }
424 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
425 is($st->pkid1, 55, "Auto-PK for sequence without default: First primary key set manually");
4d4dc518 426
427
38d5ea9f 428######## test non-serial auto-pk
4d4dc518 429
bbdda281 430 if ($schema->storage->_use_insert_returning) {
bab40dee 431 $schema->source('TimestampPrimaryKey')->name('dbic_t_schema.timestamp_primary_key_test');
432 my $row = $schema->resultset('TimestampPrimaryKey')->create({});
433 ok $row->id;
434 }
d093d3eb 435
be860760 436######## test with_deferred_fk_checks
437
bab40dee 438 $schema->source('CD')->name('dbic_t_schema.cd');
439 $schema->source('Track')->name('dbic_t_schema.track');
440 lives_ok {
441 $schema->storage->with_deferred_fk_checks(sub {
442 $schema->resultset('Track')->create({
443 trackid => 999, cd => 999, position => 1, title => 'deferred FK track'
444 });
445 $schema->resultset('CD')->create({
446 artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd'
447 });
be860760 448 });
bab40dee 449 } 'with_deferred_fk_checks code survived';
be860760 450
bab40dee 451 is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
8273e845 452 'code in with_deferred_fk_checks worked';
be860760 453
bab40dee 454 throws_ok {
455 $schema->resultset('Track')->create({
456 trackid => 1, cd => 9999, position => 1, title => 'Track1'
457 });
458 } qr/constraint/i, 'with_deferred_fk_checks is off';
459}
be860760 460
2fbf50ff 461done_testing;
609c5f1b 462
5935c90a 463END {
f66c9ba8 464 return unless $schema;
5935c90a 465 drop_test_schema($schema);
65d35121 466 eapk_drop_all($schema);
467 undef $schema;
5935c90a 468};
70a201a5 469
470
471######### SUBROUTINES
472
473sub create_test_schema {
2fbf50ff 474 my $schema = shift;
475 $schema->storage->dbh_do(sub {
476 my (undef,$dbh) = @_;
70a201a5 477
2fbf50ff 478 local $dbh->{Warn} = 0;
70a201a5 479
2fbf50ff 480 my $std_artist_table = <<EOS;
70a201a5 481(
482 artistid serial PRIMARY KEY
483 , name VARCHAR(100)
484 , rank INTEGER NOT NULL DEFAULT '13'
485 , charfield CHAR(10)
486 , arrayfield INTEGER[]
487)
488EOS
489
881def48 490 $dbh->do("CREATE SCHEMA dbic_t_schema");
491 $dbh->do("CREATE TABLE dbic_t_schema.artist $std_artist_table");
4d4dc518 492
493 $dbh->do(<<EOS);
494CREATE TABLE dbic_t_schema.timestamp_primary_key_test (
be860760 495 id timestamp default current_timestamp
4d4dc518 496)
497EOS
2fbf50ff 498 $dbh->do(<<EOS);
be860760 499CREATE TABLE dbic_t_schema.cd (
500 cdid int PRIMARY KEY,
501 artist int,
502 title varchar(255),
503 year varchar(4),
504 genreid int,
505 single_track int
506)
507EOS
508 $dbh->do(<<EOS);
509CREATE TABLE dbic_t_schema.track (
510 trackid int,
511 cd int REFERENCES dbic_t_schema.cd(cdid) DEFERRABLE,
512 position int,
513 title varchar(255),
514 last_updated_on date,
3d98c75e 515 last_updated_at date
be860760 516)
517EOS
518
519 $dbh->do(<<EOS);
881def48 520CREATE TABLE dbic_t_schema.sequence_test (
70a201a5 521 pkid1 integer
522 , pkid2 integer
523 , nonpkid integer
524 , name VARCHAR(100)
525 , CONSTRAINT pk PRIMARY KEY(pkid1, pkid2)
526)
527EOS
2fbf50ff 528 $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
529 $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
530 $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
531 $dbh->do(<<EOS);
881def48 532CREATE TABLE dbic_t_schema.casecheck (
70a201a5 533 id serial PRIMARY KEY
534 , "name" VARCHAR(1)
535 , "NAME" VARCHAR(2)
536 , "UC_NAME" VARCHAR(3)
70a201a5 537)
538EOS
2fbf50ff 539 $dbh->do(<<EOS);
881def48 540CREATE TABLE dbic_t_schema.array_test (
70a201a5 541 id serial PRIMARY KEY
542 , arrayfield INTEGER[]
543)
544EOS
881def48 545 $dbh->do("CREATE SCHEMA dbic_t_schema_2");
546 $dbh->do("CREATE TABLE dbic_t_schema_2.artist $std_artist_table");
547 $dbh->do("CREATE SCHEMA dbic_t_schema_3");
548 $dbh->do("CREATE TABLE dbic_t_schema_3.artist $std_artist_table");
549 $dbh->do('set search_path=dbic_t_schema,public');
550 $dbh->do("CREATE SCHEMA dbic_t_schema_4");
551 $dbh->do("CREATE SCHEMA dbic_t_schema_5");
2fbf50ff 552 $dbh->do(<<EOS);
881def48 553 CREATE TABLE dbic_t_schema_4.artist
70a201a5 554 (
555 artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
556 , name VARCHAR(100)
557 , rank INTEGER NOT NULL DEFAULT '13'
558 , charfield CHAR(10)
559 , arrayfield INTEGER[]
560 );
561EOS
881def48 562 $dbh->do('set search_path=public,dbic_t_schema,dbic_t_schema_3');
2fbf50ff 563 $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema
564 $dbh->do(<<EOS);
881def48 565 CREATE TABLE dbic_t_schema_5.artist
70a201a5 566 (
567 artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
568 , name VARCHAR(100)
569 , rank INTEGER NOT NULL DEFAULT '13'
570 , charfield CHAR(10)
571 , arrayfield INTEGER[]
572 );
573EOS
881def48 574 $dbh->do('set search_path=dbic_t_schema,public');
2fbf50ff 575 });
70a201a5 576}
577
578
579
580sub drop_test_schema {
52c53388 581 my ( $schema, $warn_exceptions ) = @_;
2fbf50ff 582
583 $schema->storage->dbh_do(sub {
584 my (undef,$dbh) = @_;
585
586 local $dbh->{Warn} = 0;
587
588 for my $stat (
881def48 589 'DROP SCHEMA dbic_t_schema_5 CASCADE',
e78c769d 590 'DROP SEQUENCE public.artist_artistid_seq CASCADE',
881def48 591 'DROP SCHEMA dbic_t_schema_4 CASCADE',
592 'DROP SCHEMA dbic_t_schema CASCADE',
e78c769d 593 'DROP SEQUENCE pkid1_seq CASCADE',
594 'DROP SEQUENCE pkid2_seq CASCADE',
595 'DROP SEQUENCE nonpkid_seq CASCADE',
881def48 596 'DROP SCHEMA dbic_t_schema_2 CASCADE',
597 'DROP SCHEMA dbic_t_schema_3 CASCADE',
2fbf50ff 598 ) {
599 eval { $dbh->do ($stat) };
52c53388 600 diag $@ if $@ && $warn_exceptions;
2fbf50ff 601 }
602 });
3ff5b740 603}
7603d2a5 604
372da819 605
ee9f372c 606### auto-pk / last_insert_id / sequence discovery
607sub run_apk_tests {
608 my $schema = shift;
609
610 # This is in Core now, but it's here just to test that it doesn't break
611 $schema->class('Artist')->load_components('PK::Auto');
612 cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
613
614 # test that auto-pk also works with the defined search path by
615 # un-schema-qualifying the table name
616 apk_t_set($schema,'artist');
617
618 my $unq_new;
619 lives_ok {
620 $unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
621 } 'insert into unqualified, shadowed table succeeds';
622
623 is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
624
625 my @test_schemas = ( [qw| dbic_t_schema_2 1 |],
626 [qw| dbic_t_schema_3 1 |],
627 [qw| dbic_t_schema_4 2 |],
628 [qw| dbic_t_schema_5 1 |],
629 );
630 foreach my $t ( @test_schemas ) {
631 my ($sch_name, $start_num) = @$t;
632 #test with dbic_t_schema_2
633 apk_t_set($schema,"$sch_name.artist");
634 my $another_new;
635 lives_ok {
636 $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
637 is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
638 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
639 } "$sch_name liid 1 did not die"
640 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
641 lives_ok {
642 $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
643 is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
644 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
645 } "$sch_name liid 2 did not die"
646 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
647
648 }
649
650 lives_ok {
651 apk_t_set($schema,'dbic_t_schema.artist');
652 my $new = $schema->resultset('Artist')->create({ name => 'foo' });
653 is($new->artistid, 4, "Auto-PK worked");
654 $new = $schema->resultset('Artist')->create({ name => 'bar' });
655 is($new->artistid, 5, "Auto-PK worked");
656 } 'old auto-pk tests did not die either';
657}
658
ee9f372c 659# sets the artist table name and clears sequence name cache
660sub apk_t_set {
661 my ( $s, $n ) = @_;
662 $s->source("Artist")->name($n);
663 $s->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
664}
665
372da819 666
5935c90a 667######## EXTENDED AUTO-PK TESTS
668
f295a73c 669my @eapk_id_columns;
5935c90a 670BEGIN {
671 package DBICTest::Schema::ExtAPK;
672 push @main::test_classes, __PACKAGE__;
673
674 use strict;
675 use warnings;
d88ecca6 676 use base 'DBIx::Class::Core';
5935c90a 677
f295a73c 678 __PACKAGE__->table('apk');
5935c90a 679
f295a73c 680 @eapk_id_columns = qw( id1 id2 id3 id4 );
5935c90a 681 __PACKAGE__->add_columns(
682 map { $_ => { data_type => 'integer', is_auto_increment => 1 } }
f295a73c 683 @eapk_id_columns
5935c90a 684 );
685
f295a73c 686 __PACKAGE__->set_primary_key('id2'); #< note the SECOND column is
687 #the primary key
5935c90a 688}
689
f295a73c 690my @eapk_schemas;
691BEGIN{ @eapk_schemas = map "dbic_apk_$_", 0..5 }
ae645c61 692my %seqs; #< hash of schema.table.col => currval of its (DBIC) primary key sequence
5935c90a 693
372da819 694sub run_extended_apk_tests {
11da4e66 695 my $schema = shift;
372da819 696
f295a73c 697 #save the search path and reset it at the end
49aa7e87 698 my $search_path_save = eapk_get_search_path($schema);
f295a73c 699
52c53388 700 eapk_drop_all($schema);
bab40dee 701 %seqs = ();
5935c90a 702
f295a73c 703 # make the test schemas and sequences
11da4e66 704 $schema->storage->dbh_do(sub {
f295a73c 705 my ( undef, $dbh ) = @_;
706
707 $dbh->do("CREATE SCHEMA $_")
708 for @eapk_schemas;
709
710 $dbh->do("CREATE SEQUENCE $eapk_schemas[5].fooseq");
ae645c61 711 $dbh->do("SELECT setval('$eapk_schemas[5].fooseq',400)");
712 $seqs{"$eapk_schemas[1].apk.id2"} = 400;
713
fb7be534 714 $dbh->do("CREATE SEQUENCE $eapk_schemas[4].fooseq");
ae645c61 715 $dbh->do("SELECT setval('$eapk_schemas[4].fooseq',300)");
716 $seqs{"$eapk_schemas[3].apk.id2"} = 300;
717
93a6e8fa 718 $dbh->do("CREATE SEQUENCE $eapk_schemas[3].fooseq");
ae645c61 719 $dbh->do("SELECT setval('$eapk_schemas[3].fooseq',200)");
720 $seqs{"$eapk_schemas[4].apk.id2"} = 200;
f295a73c 721
78c9596c 722 $dbh->do("SET search_path = ".join ',', reverse @eapk_schemas );
11da4e66 723 });
372da819 724
f295a73c 725 # clear our search_path cache
726 $schema->storage->{_pg_search_path} = undef;
727
728 eapk_create( $schema,
729 with_search_path => [0,1],
730 );
731 eapk_create( $schema,
732 with_search_path => [1,0,'public'],
733 nextval => "$eapk_schemas[5].fooseq",
734 );
735 eapk_create( $schema,
736 with_search_path => ['public',0,1],
737 qualify_table => 2,
738 );
fb7be534 739 eapk_create( $schema,
740 with_search_path => [3,1,0,'public'],
741 nextval => "$eapk_schemas[4].fooseq",
742 );
93a6e8fa 743 eapk_create( $schema,
744 with_search_path => [3,1,0,'public'],
745 nextval => "$eapk_schemas[3].fooseq",
746 qualify_table => 4,
747 );
372da819 748
78c9596c 749 eapk_poke( $schema );
f295a73c 750 eapk_poke( $schema, 0 );
eb80e8d5 751 eapk_poke( $schema, 2 );
93a6e8fa 752 eapk_poke( $schema, 4 );
f295a73c 753 eapk_poke( $schema, 1 );
eb80e8d5 754 eapk_poke( $schema, 0 );
f295a73c 755 eapk_poke( $schema, 1 );
78c9596c 756 eapk_poke( $schema );
93a6e8fa 757 eapk_poke( $schema, 4 );
fb7be534 758 eapk_poke( $schema, 3 );
eb80e8d5 759 eapk_poke( $schema, 1 );
760 eapk_poke( $schema, 2 );
761 eapk_poke( $schema, 0 );
f295a73c 762
763 # set our search path back
764 eapk_set_search_path( $schema, @$search_path_save );
765}
766
767# do a DBIC create on the apk table in the given schema number (which is an
768# index of @eapk_schemas)
769
f295a73c 770sub eapk_poke {
771 my ($s, $schema_num) = @_;
372da819 772
f295a73c 773 my $schema_name = defined $schema_num
774 ? $eapk_schemas[$schema_num]
775 : '';
776
78c9596c 777 my $schema_name_actual = $schema_name || eapk_find_visible_schema($s);
f295a73c 778
8ce84173 779 $s->source('ExtAPK')->name($schema_name ? $schema_name.'.apk' : 'apk');
f295a73c 780 #< clear sequence name cache
781 $s->source('ExtAPK')->column_info($_)->{sequence} = undef
782 for @eapk_id_columns;
783
784 no warnings 'uninitialized';
785 lives_ok {
786 my $new;
787 for my $inc (1,2,3) {
ae645c61 788 $new = $schema->resultset('ExtAPK')->create({ id1 => 1});
691f3663 789 my $proper_seqval = ++$seqs{"$schema_name_actual.apk.id2"};
790 is( $new->id2, $proper_seqval, "$schema_name_actual.apk.id2 correct inc $inc" )
791 or eapk_seq_diag($s,$schema_name);
792 $new->discard_changes;
ae645c61 793 is( $new->id1, 1 );
794 for my $id ('id3','id4') {
f295a73c 795 my $proper_seqval = ++$seqs{"$schema_name_actual.apk.$id"};
93a6e8fa 796 is( $new->$id, $proper_seqval, "$schema_name_actual.apk.$id correct inc $inc" )
fb7be534 797 or eapk_seq_diag($s,$schema_name);
f295a73c 798 }
799 }
800 } "create in schema '$schema_name' lives"
fb7be534 801 or eapk_seq_diag($s,$schema_name);
372da819 802}
803
f295a73c 804# print diagnostic info on which sequences were found in the ExtAPK
805# class
806sub eapk_seq_diag {
807 my $s = shift;
78c9596c 808 my $schema = shift || eapk_find_visible_schema($s);
f295a73c 809
810 diag "$schema.apk sequences: ",
811 join(', ',
812 map "$_:".($s->source('ExtAPK')->column_info($_)->{sequence} || '<none>'),
813 @eapk_id_columns
814 );
815}
816
49aa7e87 817# get the postgres search path as an arrayref
818sub eapk_get_search_path {
819 my ( $s ) = @_;
820 # cache the search path as ['schema','schema',...] in the storage
821 # obj
822
823 return $s->storage->dbh_do(sub {
824 my (undef, $dbh) = @_;
825 my @search_path;
826 my ($sp_string) = $dbh->selectrow_array('SHOW search_path');
827 while ( $sp_string =~ s/("[^"]+"|[^,]+),?// ) {
828 unless( defined $1 and length $1 ) {
829 die "search path sanity check failed: '$1'";
830 }
831 push @search_path, $1;
832 }
833 \@search_path
834 });
835}
f295a73c 836sub eapk_set_search_path {
837 my ($s,@sp) = @_;
838 my $sp = join ',',@sp;
839 $s->storage->dbh_do( sub { $_[1]->do("SET search_path = $sp") } );
840}
841
842# create the apk table in the given schema, can set whether the table name is qualified, what the nextval is for the second ID
5935c90a 843sub eapk_create {
844 my ($schema, %a) = @_;
845
372da819 846 $schema->storage->dbh_do(sub {
5935c90a 847 my (undef,$dbh) = @_;
372da819 848
5935c90a 849 my $searchpath_save;
850 if ( $a{with_search_path} ) {
851 ($searchpath_save) = $dbh->selectrow_array('SHOW search_path');
852
f295a73c 853 my $search_path = join ',',map {/\D/ ? $_ : $eapk_schemas[$_]} @{$a{with_search_path}};
5935c90a 854
855 $dbh->do("SET search_path = $search_path");
856 }
857
f295a73c 858 my $table_name = $a{qualify_table}
859 ? ($eapk_schemas[$a{qualify_table}] || die). ".apk"
860 : 'apk';
e25fe566 861 local $_[1]->{Warn} = 0;
f295a73c 862
863 my $id_def = $a{nextval}
ae645c61 864 ? "integer not null default nextval('$a{nextval}'::regclass)"
865 : 'serial';
5935c90a 866 $dbh->do(<<EOS);
f295a73c 867CREATE TABLE $table_name (
868 id1 serial
869 , id2 $id_def
ae645c61 870 , id3 serial primary key
5935c90a 871 , id4 serial
872)
873EOS
372da819 874
5935c90a 875 if( $searchpath_save ) {
876 $dbh->do("SET search_path = $searchpath_save");
877 }
372da819 878 });
879}
880
5935c90a 881sub eapk_drop_all {
52c53388 882 my ( $schema, $warn_exceptions ) = @_;
372da819 883
884 $schema->storage->dbh_do(sub {
885 my (undef,$dbh) = @_;
886
887 local $dbh->{Warn} = 0;
5935c90a 888
889 # drop the test schemas
f295a73c 890 for (@eapk_schemas ) {
11da4e66 891 eval{ $dbh->do("DROP SCHEMA $_ CASCADE") };
52c53388 892 diag $@ if $@ && $warn_exceptions;
11da4e66 893 }
894
372da819 895
372da819 896 });
897}
78c9596c 898
899sub eapk_find_visible_schema {
900 my ($s) = @_;
901
902 my ($schema) =
903 $s->storage->dbh_do(sub {
904 $_[1]->selectrow_array(<<EOS);
905SELECT n.nspname
906FROM pg_catalog.pg_namespace n
907JOIN pg_catalog.pg_class c ON c.relnamespace = n.oid
908WHERE c.relname = 'apk'
909 AND pg_catalog.pg_table_is_visible(c.oid)
910EOS
911 });
912 return $schema;
913}