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