Rewrap todo properly
[dbsrgits/DBIx-Class-Historic.git] / t / 72pg.t
1 use strict;
2 use warnings;
3
4 use Test::More;
5 use Test::Warn;
6 use Test::Exception;
7 use lib qw(t/lib);
8 use DBICTest;
9
10 {
11   package DBICTest::Schema::Casecheck;
12
13   use strict;
14   use warnings;
15   use base 'DBIx::Class';
16
17   __PACKAGE__->load_components(qw/Core/);
18   __PACKAGE__->table('testschema.casecheck');
19   __PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/);
20   __PACKAGE__->column_info_from_storage(1);
21   __PACKAGE__->set_primary_key('id');
22
23   sub store_column {
24     my ($self, $name, $value) = @_;
25     $value = '#'.$value if($name eq "storecolumn");
26     $self->maybe::next::method($name, $value);
27   }
28 }
29
30 {
31   package DBICTest::Schema::ArrayTest;
32
33   use strict;
34   use warnings;
35   use base 'DBIx::Class';
36
37   __PACKAGE__->load_components(qw/Core/);
38   __PACKAGE__->table('testschema.array_test');
39   __PACKAGE__->add_columns(qw/id arrayfield/);
40   __PACKAGE__->column_info_from_storage(1);
41   __PACKAGE__->set_primary_key('id');
42
43 }
44
45 my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_PG_${_}" } qw/DSN USER PASS/};
46
47 plan skip_all => <<EOM unless $dsn && $user;
48 Set \$ENV{DBICTEST_PG_DSN}, _USER and _PASS to run this test
49 ( NOTE: This test drops and creates tables called 'artist', 'casecheck',
50   'array_test' and 'sequence_test' as well as following sequences:
51   'pkid1_seq', 'pkid2_seq' and 'nonpkid_seq''.  as well as following
52   schemas: 'testschema', 'anothertestschema', 'yetanothertestschema',
53   'unq_nextval_schema', and 'unq_nextval_schema2'
54 )
55 EOM
56
57 DBICTest::Schema->load_classes( 'Casecheck', 'ArrayTest' );
58
59 # make sure sqlt_type overrides work (::Storage::DBI::Pg does this)
60 {
61   my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
62
63   ok (!$schema->storage->_dbh, 'definitely not connected');
64   is ($schema->storage->sqlt_type, 'PostgreSQL', 'sqlt_type correct pre-connection');
65 }
66
67 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
68 # Check that datetime_parser returns correctly before we explicitly connect.
69 SKIP: {
70     eval { require DateTime::Format::Pg };
71     skip "DateTime::Format::Pg required", 2 if $@;
72
73     my $store = ref $schema->storage;
74     is($store, 'DBIx::Class::Storage::DBI', 'Started with generic storage');
75
76     my $parser = $schema->storage->datetime_parser;
77     is( $parser, 'DateTime::Format::Pg', 'datetime_parser is as expected');
78 }
79
80 my $dbh = $schema->storage->dbh;
81 $schema->source("Artist")->name("testschema.artist");
82 $schema->source("SequenceTest")->name("testschema.sequence_test");
83 {
84     local $SIG{__WARN__} = sub {};
85     _cleanup ($dbh);
86
87     my $artist_table_def = <<EOS;
88 (
89   artistid serial PRIMARY KEY
90   , name VARCHAR(100)
91   , rank INTEGER NOT NULL DEFAULT '13'
92   , charfield CHAR(10)
93   , arrayfield INTEGER[]
94 )
95 EOS
96     $dbh->do("CREATE SCHEMA testschema;");
97     $dbh->do("CREATE TABLE testschema.artist $artist_table_def;");
98     $dbh->do("CREATE TABLE testschema.sequence_test (pkid1 integer, pkid2 integer, nonpkid integer, name VARCHAR(100), CONSTRAINT pk PRIMARY KEY(pkid1, pkid2));");
99     $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
100     $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
101     $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
102     ok ( $dbh->do('CREATE TABLE testschema.casecheck (id serial PRIMARY KEY, "name" VARCHAR(1), "NAME" VARCHAR(2), "UC_NAME" VARCHAR(3), "storecolumn" VARCHAR(10));'), 'Creation of casecheck table');
103     ok ( $dbh->do('CREATE TABLE testschema.array_test (id serial PRIMARY KEY, arrayfield INTEGER[]);'), 'Creation of array_test table');
104     $dbh->do("CREATE SCHEMA anothertestschema;");
105     $dbh->do("CREATE TABLE anothertestschema.artist $artist_table_def;");
106     $dbh->do("CREATE SCHEMA yetanothertestschema;");
107     $dbh->do("CREATE TABLE yetanothertestschema.artist $artist_table_def;");
108     $dbh->do('set search_path=testschema,public');
109     $dbh->do("CREATE SCHEMA unq_nextval_schema;");
110     $dbh->do("CREATE SCHEMA unq_nextval_schema2;");
111     $dbh->do(<<EOS);
112  CREATE TABLE unq_nextval_schema.artist
113  (
114    artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
115    , name VARCHAR(100)
116    , rank INTEGER NOT NULL DEFAULT '13'
117    , charfield CHAR(10)
118    , arrayfield INTEGER[]
119  );
120 EOS
121     $dbh->do('set search_path=public,testschema,yetanothertestschema');
122     $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema
123     $dbh->do(<<EOS);
124  CREATE TABLE unq_nextval_schema2.artist
125  (
126    artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
127    , name VARCHAR(100)
128    , rank INTEGER NOT NULL DEFAULT '13'
129    , charfield CHAR(10)
130    , arrayfield INTEGER[]
131  );
132 EOS
133     $dbh->do('set search_path=testschema,public');
134
135 }
136
137 # store_column is called once for create() for non sequence columns
138
139 ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'}));
140
141 is($storecolumn->storecolumn, '#a'); # was '##a'
142
143 # This is in Core now, but it's here just to test that it doesn't break
144 $schema->class('Artist')->load_components('PK::Auto');
145
146 cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
147
148 { # test that auto-pk also works with the defined search path by
149   # un-schema-qualifying the table name
150   my $artist_name_save = $schema->source("Artist")->name;
151   $schema->source("Artist")->name("artist");
152
153   my $unq_new;
154   lives_ok {
155       $unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
156   } 'insert into unqualified, shadowed table succeeds';
157
158   is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
159
160   my @test_schemas = ( [qw| anothertestschema    1      |],
161                        [qw| yetanothertestschema 1      |],
162                      );
163   foreach my $t ( @test_schemas ) {
164       my ($sch_name, $start_num) = @$t;
165       #test with anothertestschema
166       $schema->source('Artist')->name("$sch_name.artist");
167       $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
168       my $another_new;
169       lives_ok {
170           $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
171           is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
172               or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
173       } "$sch_name liid 1 did not die"
174           or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
175       lives_ok {
176           $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
177           is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
178               or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
179       } "$sch_name liid 2 did not die"
180           or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
181
182   }
183
184
185   my @todo_schemas = (
186                       [qw| unq_nextval_schema   2 |],
187                       [qw| unq_nextval_schema2  1 |],
188                      );
189   TODO: {
190     local $TODO = 'have not figured out a 100% reliable way to tell which schema an unqualified seq is in';
191     warnings_exist (
192       sub {
193         foreach my $t ( @todo_schemas ) {
194           my ($sch_name, $start_num) = @$t;
195           #test with anothertestschema
196           $schema->source('Artist')->name("$sch_name.artist");
197           $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
198           my $another_new;
199           lives_ok {
200             $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
201             is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
202               or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
203           } "$sch_name liid 1 did not die"
204             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
205
206           lives_ok {
207             $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
208             is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
209               or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
210           } "$sch_name liid 2 did not die"
211             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
212         }
213       },
214       [ (qr/guessing sequence/)x2],
215       'got a bunch of warnings from unqualified schema guessing'
216     );
217   }
218
219   $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
220   $schema->source("Artist")->name($artist_name_save);
221 }
222
223 my $new;
224 lives_ok {
225     $new = $schema->resultset('Artist')->create({ name => 'foo' });
226     is($new->artistid, 4, "Auto-PK worked");
227     $new = $schema->resultset('Artist')->create({ name => 'bar' });
228     is($new->artistid, 5, "Auto-PK worked");
229 } 'old auto-pk tests did not die either';
230
231
232 my $test_type_info = {
233     'artistid' => {
234         'data_type' => 'integer',
235         'is_nullable' => 0,
236         'size' => 4,
237     },
238     'name' => {
239         'data_type' => 'character varying',
240         'is_nullable' => 1,
241         'size' => 100,
242         'default_value' => undef,
243     },
244     'rank' => {
245         'data_type' => 'integer',
246         'is_nullable' => 0,
247         'size' => 4,
248         'default_value' => 13,
249
250     },
251     'charfield' => {
252         'data_type' => 'character',
253         'is_nullable' => 1,
254         'size' => 10,
255         'default_value' => undef,
256     },
257     'arrayfield' => {
258         'data_type' => 'integer[]',
259         'is_nullable' => 1,
260         'size' => undef,
261         'default_value' => undef,
262     },
263 };
264
265
266 my $type_info = $schema->storage->columns_info_for('testschema.artist');
267 my $artistid_defval = delete $type_info->{artistid}->{default_value};
268 like($artistid_defval,
269      qr/^nextval\('([^\.]*\.){0,1}artist_artistid_seq'::(?:text|regclass)\)/,
270      'columns_info_for - sequence matches Pg get_autoinc_seq expectations');
271 is_deeply($type_info, $test_type_info,
272           'columns_info_for - column data types');
273
274 SKIP: {
275   skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
276
277   lives_ok {
278     $schema->resultset('ArrayTest')->create({
279       arrayfield => [1, 2],
280     });
281   } 'inserting arrayref as pg array data';
282
283   lives_ok {
284     $schema->resultset('ArrayTest')->update({
285       arrayfield => [3, 4],
286     });
287   } 'updating arrayref as pg array data';
288
289   $schema->resultset('ArrayTest')->create({
290     arrayfield => [5, 6],
291   });
292
293   my $count;
294   lives_ok {
295     $count = $schema->resultset('ArrayTest')->search({
296       arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ],   #Todo anything less ugly than this?
297     })->count;
298   } 'comparing arrayref to pg array data does not blow up';
299   is($count, 1, 'comparing arrayref to pg array data gives correct result');
300 }
301
302
303 my $name_info = $schema->source('Casecheck')->column_info( 'name' );
304 is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
305
306 my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' );
307 is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" );
308
309 my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
310 is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
311
312 # Test SELECT ... FOR UPDATE
313 my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
314 if ($HaveSysSigAction) {
315     Sys::SigAction->import( 'set_sig_handler' );
316 }
317
318 SKIP: {
319     skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
320     # create a new schema
321     my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
322     $schema2->source("Artist")->name("testschema.artist");
323
324     $schema->txn_do( sub {
325         my $artist = $schema->resultset('Artist')->search(
326             {
327                 artistid => 1
328             },
329             {
330                 for => 'update'
331             }
332         )->first;
333         is($artist->artistid, 1, "select for update returns artistid = 1");
334
335         my $artist_from_schema2;
336         my $error_ok = 0;
337         eval {
338             my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
339             alarm(2);
340             $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
341             $artist_from_schema2->name('fooey');
342             $artist_from_schema2->update;
343             alarm(0);
344         };
345         if (my $e = $@) {
346             $error_ok = $e =~ /DBICTestTimeout/;
347         }
348
349         # Make sure that an error was raised, and that the update failed
350         ok($error_ok, "update from second schema times out");
351         ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema");
352     });
353 }
354
355 SKIP: {
356     skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
357     # create a new schema
358     my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
359     $schema2->source("Artist")->name("testschema.artist");
360
361     $schema->txn_do( sub {
362         my $artist = $schema->resultset('Artist')->search(
363             {
364                 artistid => 1
365             },
366         )->first;
367         is($artist->artistid, 1, "select for update returns artistid = 1");
368
369         my $artist_from_schema2;
370         my $error_ok = 0;
371         eval {
372             my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
373             alarm(2);
374             $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
375             $artist_from_schema2->name('fooey');
376             $artist_from_schema2->update;
377             alarm(0);
378         };
379         if (my $e = $@) {
380             $error_ok = $e =~ /DBICTestTimeout/;
381         }
382
383         # Make sure that an error was NOT raised, and that the update succeeded
384         ok(! $error_ok, "update from second schema DOES NOT timeout");
385         ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
386     });
387 }
388
389 for (1..5) {
390     my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
391     is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
392     is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
393     is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
394 }
395 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
396 is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
397
398 #_cleanup ($dbh);
399
400 done_testing;
401
402
403 sub _cleanup {
404   my $dbh = shift or return;
405   $dbh->ping or return;
406
407   for my $stat (
408     'DROP TABLE unq_nextval_schema2.artist',
409     'DROP SCHEMA unq_nextval_schema2',
410     'DROP SEQUENCE public.artist_artistid_seq',
411     'DROP TABLE unq_nextval_schema.artist',
412     'DROP SCHEMA unq_nextval_schema',
413     'DROP TABLE testschema.artist',
414     'DROP TABLE testschema.casecheck',
415     'DROP TABLE testschema.sequence_test',
416     'DROP TABLE testschema.array_test',
417     'DROP SEQUENCE pkid1_seq',
418     'DROP SEQUENCE pkid2_seq',
419     'DROP SEQUENCE nonpkid_seq',
420     'DROP SCHEMA testschema',
421     'DROP TABLE anothertestschema.artist',
422     'DROP SCHEMA anothertestschema',
423     'DROP TABLE yetanothertestschema.artist',
424     'DROP SCHEMA yetanothertestschema',
425   ) {
426     eval { $dbh->do ($stat) };
427     diag $@ if $@;
428   }
429 }
430
431 END { _cleanup($dbh) }