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