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