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