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: 'testschema', 'anothertestschema', 'yetanothertestschema',
  18   'unq_nextval_schema', and 'unq_nextval_schema2'
  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 my $dbh = $schema->storage->dbh;
  55
  56 drop_test_schema($dbh, 'no warn');
  57 create_test_schema($dbh);
  58
  59 ### begin main tests
  60
  61 ###  auto-pk / last_insert_id / sequence discovery
  62 {
  63
  64     $schema->source("Artist")->name("testschema.artist");
  65
  66     # This is in Core now, but it's here just to test that it doesn't break
  67     $schema->class('Artist')->load_components('PK::Auto');
  68     cmp_ok( $schema->resultset('Artist')->count, '==', 0, 'this should start with an empty artist table');
  69
  70     # test that auto-pk also works with the defined search path by
  71     # un-schema-qualifying the table name
  72     my $artist_name_save = $schema->source("Artist")->name;
  73     $schema->source("Artist")->name("artist");
  74
  75     my $unq_new;
  76     lives_ok {
  77         $unq_new = $schema->resultset('Artist')->create({ name => 'baz' });
  78     } 'insert into unqualified, shadowed table succeeds';
  79
  80     is($unq_new && $unq_new->artistid, 1, "and got correct artistid");
  81
  82     my @test_schemas = ( [qw| anothertestschema    1      |],
  83                          [qw| yetanothertestschema 1      |],
  84                        );
  85     foreach my $t ( @test_schemas ) {
  86         my ($sch_name, $start_num) = @$t;
  87         #test with anothertestschema
  88         $schema->source('Artist')->name("$sch_name.artist");
  89         $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
  90         my $another_new;
  91         lives_ok {
  92             $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
  93             is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
  94                 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
  95         } "$sch_name liid 1 did not die"
  96             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
  97         lives_ok {
  98             $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
  99             is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
 100                 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 101         } "$sch_name liid 2 did not die"
 102             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 103
 104     }
 105
 106
 107     my @todo_schemas = (
 108                         [qw| unq_nextval_schema   2 |],
 109                         [qw| unq_nextval_schema2  1 |],
 110                        );
 111
 112     foreach my $t ( @todo_schemas ) {
 113         my ($sch_name, $start_num) = @$t;
 114
 115         #test with anothertestschema
 116         $schema->source('Artist')->name("$sch_name.artist");
 117         $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
 118         my $another_new;
 119         lives_ok {
 120             $another_new = $schema->resultset('Artist')->create({ name => 'Tollbooth Willy'});
 121             is( $another_new->artistid,$start_num, "got correct artistid for $sch_name")
 122                 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 123         } "$sch_name liid 1 did not die"
 124             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 125
 126         lives_ok {
 127             $another_new = $schema->resultset('Artist')->create({ name => 'Adam Sandler'});
 128             is( $another_new->artistid,$start_num+1, "got correct artistid for $sch_name")
 129                 or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 130         } "$sch_name liid 2 did not die"
 131             or diag "USED SEQUENCE: ".($schema->source('Artist')->column_info('artistid')->{sequence} || '<none>');
 132     }
 133
 134     $schema->source('Artist')->column_info('artistid')->{sequence} = undef; #< clear sequence name cache
 135     $schema->source("Artist")->name($artist_name_save);
 136 }
 137
 138 lives_ok {
 139     my $new = $schema->resultset('Artist')->create({ name => 'foo' });
 140     is($new->artistid, 4, "Auto-PK worked");
 141     $new = $schema->resultset('Artist')->create({ name => 'bar' });
 142     is($new->artistid, 5, "Auto-PK worked");
 143 } 'old auto-pk tests did not die either';
 144
 145
 146
 147 ### type_info tests
 148
 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,
 166
 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 };
 181
 182 my $type_info = $schema->storage->columns_info_for('testschema.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');
 189
 190
 191
 192
 193 ####### Array tests
 194
 195 BEGIN {
 196   package DBICTest::Schema::ArrayTest;
 197   push @main::test_classes, __PACKAGE__;
 198
 199   use strict;
 200   use warnings;
 201   use base 'DBIx::Class';
 202
 203   __PACKAGE__->load_components(qw/Core/);
 204   __PACKAGE__->table('testschema.array_test');
 205   __PACKAGE__->add_columns(qw/id arrayfield/);
 206   __PACKAGE__->column_info_from_storage(1);
 207   __PACKAGE__->set_primary_key('id');
 208
 209 }
 210 SKIP: {
 211   skip "Need DBD::Pg 2.9.2 or newer for array tests", 4 if $DBD::Pg::VERSION < 2.009002;
 212
 213   lives_ok {
 214     $schema->resultset('ArrayTest')->create({
 215       arrayfield => [1, 2],
 216     });
 217   } 'inserting arrayref as pg array data';
 218
 219   lives_ok {
 220     $schema->resultset('ArrayTest')->update({
 221       arrayfield => [3, 4],
 222     });
 223   } 'updating arrayref as pg array data';
 224
 225   $schema->resultset('ArrayTest')->create({
 226     arrayfield => [5, 6],
 227   });
 228
 229   my $count;
 230   lives_ok {
 231     $count = $schema->resultset('ArrayTest')->search({
 232       arrayfield => \[ '= ?' => [arrayfield => [3, 4]] ],   #Todo anything less ugly than this?
 233     })->count;
 234   } 'comparing arrayref to pg array data does not blow up';
 235   is($count, 1, 'comparing arrayref to pg array data gives correct result');
 236 }
 237
 238
 239
 240 ########## Case check
 241
 242 BEGIN {
 243   package DBICTest::Schema::Casecheck;
 244   push @main::test_classes, __PACKAGE__;
 245
 246   use strict;
 247   use warnings;
 248   use base 'DBIx::Class';
 249
 250   __PACKAGE__->load_components(qw/Core/);
 251   __PACKAGE__->table('testschema.casecheck');
 252   __PACKAGE__->add_columns(qw/id name NAME uc_name storecolumn/);
 253   __PACKAGE__->column_info_from_storage(1);
 254   __PACKAGE__->set_primary_key('id');
 255
 256   sub store_column {
 257     my ($self, $name, $value) = @_;
 258     $value = '#'.$value if($name eq "storecolumn");
 259     $self->maybe::next::method($name, $value);
 260   }
 261 }
 262
 263 # store_column is called once for create() for non sequence columns
 264 ok(my $storecolumn = $schema->resultset('Casecheck')->create({'storecolumn' => 'a'}));
 265 is($storecolumn->storecolumn, '#a'); # was '##a'
 266
 267 my $name_info = $schema->source('Casecheck')->column_info( 'name' );
 268 is( $name_info->{size}, 1, "Case sensitive matching info for 'name'" );
 269
 270 my $NAME_info = $schema->source('Casecheck')->column_info( 'NAME' );
 271 is( $NAME_info->{size}, 2, "Case sensitive matching info for 'NAME'" );
 272
 273 my $uc_name_info = $schema->source('Casecheck')->column_info( 'uc_name' );
 274 is( $uc_name_info->{size}, 3, "Case insensitive matching info for 'uc_name'" );
 275
 276
 277
 278
 279 ## Test SELECT ... FOR UPDATE
 280
 281 my $HaveSysSigAction = eval "require Sys::SigAction" && !$@;
 282 if( $HaveSysSigAction ) {
 283     Sys::SigAction->import( 'set_sig_handler' );
 284 }
 285 SKIP: {
 286     skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
 287     # create a new schema
 288     my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
 289     $schema2->source("Artist")->name("testschema.artist");
 290
 291     $schema->txn_do( sub {
 292         my $artist = $schema->resultset('Artist')->search(
 293             {
 294                 artistid => 1
 295             },
 296             {
 297                 for => 'update'
 298             }
 299         )->first;
 300         is($artist->artistid, 1, "select for update returns artistid = 1");
 301
 302         my $artist_from_schema2;
 303         my $error_ok = 0;
 304         eval {
 305             my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
 306             alarm(2);
 307             $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
 308             $artist_from_schema2->name('fooey');
 309             $artist_from_schema2->update;
 310             alarm(0);
 311         };
 312         if (my $e = $@) {
 313             $error_ok = $e =~ /DBICTestTimeout/;
 314         }
 315
 316         # Make sure that an error was raised, and that the update failed
 317         ok($error_ok, "update from second schema times out");
 318         ok($artist_from_schema2->is_column_changed('name'), "'name' column is still dirty from second schema");
 319     });
 320 }
 321
 322 SKIP: {
 323     skip "Sys::SigAction is not available", 3 unless $HaveSysSigAction;
 324     # create a new schema
 325     my $schema2 = DBICTest::Schema->connect($dsn, $user, $pass);
 326     $schema2->source("Artist")->name("testschema.artist");
 327
 328     $schema->txn_do( sub {
 329         my $artist = $schema->resultset('Artist')->search(
 330             {
 331                 artistid => 1
 332             },
 333         )->first;
 334         is($artist->artistid, 1, "select for update returns artistid = 1");
 335
 336         my $artist_from_schema2;
 337         my $error_ok = 0;
 338         eval {
 339             my $h = set_sig_handler( 'ALRM', sub { die "DBICTestTimeout" } );
 340             alarm(2);
 341             $artist_from_schema2 = $schema2->resultset('Artist')->find(1);
 342             $artist_from_schema2->name('fooey');
 343             $artist_from_schema2->update;
 344             alarm(0);
 345         };
 346         if (my $e = $@) {
 347             $error_ok = $e =~ /DBICTestTimeout/;
 348         }
 349
 350         # Make sure that an error was NOT raised, and that the update succeeded
 351         ok(! $error_ok, "update from second schema DOES NOT timeout");
 352         ok(! $artist_from_schema2->is_column_changed('name'), "'name' column is NOT dirty from second schema");
 353     });
 354 }
 355
 356
 357 ######## other Auto-pk tests
 358
 359 $schema->source("SequenceTest")->name("testschema.sequence_test");
 360 for (1..5) {
 361     my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
 362     is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
 363     is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
 364     is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
 365 }
 366 my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
 367 is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
 368
 369 drop_test_schema($dbh);
 370 done_testing;
 371
 372 exit;
 373 END { drop_test_schema($dbh) }
 374
 375
 376 ######### SUBROUTINES
 377
 378 sub create_test_schema {
 379     my $dbh = shift;
 380
 381     local $SIG{__WARN__} = sub {};
 382
 383     my $std_artist_table = <<EOS;
 384 (
 385   artistid serial PRIMARY KEY
 386   , name VARCHAR(100)
 387   , rank INTEGER NOT NULL DEFAULT '13'
 388   , charfield CHAR(10)
 389   , arrayfield INTEGER[]
 390 )
 391 EOS
 392
 393     $dbh->do("CREATE SCHEMA testschema");
 394     $dbh->do("CREATE TABLE testschema.artist $std_artist_table");
 395     $dbh->do(<<EOS);
 396 CREATE TABLE testschema.sequence_test (
 397     pkid1 integer
 398     , pkid2 integer
 399     , nonpkid integer
 400     , name VARCHAR(100)
 401     , CONSTRAINT pk PRIMARY KEY(pkid1, pkid2)
 402 )
 403 EOS
 404     $dbh->do("CREATE SEQUENCE pkid1_seq START 1 MAXVALUE 999999 MINVALUE 0");
 405     $dbh->do("CREATE SEQUENCE pkid2_seq START 10 MAXVALUE 999999 MINVALUE 0");
 406     $dbh->do("CREATE SEQUENCE nonpkid_seq START 20 MAXVALUE 999999 MINVALUE 0");
 407     $dbh->do(<<EOS);
 408 CREATE TABLE testschema.casecheck (
 409     id serial PRIMARY KEY
 410     , "name" VARCHAR(1)
 411     , "NAME" VARCHAR(2)
 412     , "UC_NAME" VARCHAR(3)
 413     , "storecolumn" VARCHAR(10)
 414 )
 415 EOS
 416     $dbh->do(<<EOS);
 417 CREATE TABLE testschema.array_test (
 418     id serial PRIMARY KEY
 419     , arrayfield INTEGER[]
 420 )
 421 EOS
 422     $dbh->do("CREATE SCHEMA anothertestschema");
 423     $dbh->do("CREATE TABLE anothertestschema.artist $std_artist_table");
 424     $dbh->do("CREATE SCHEMA yetanothertestschema");
 425     $dbh->do("CREATE TABLE yetanothertestschema.artist $std_artist_table");
 426     $dbh->do('set search_path=testschema,public');
 427     $dbh->do("CREATE SCHEMA unq_nextval_schema");
 428     $dbh->do("CREATE SCHEMA unq_nextval_schema2");
 429     $dbh->do(<<EOS);
 430  CREATE TABLE unq_nextval_schema.artist
 431  (
 432    artistid integer not null default nextval('artist_artistid_seq'::regclass) PRIMARY KEY
 433    , name VARCHAR(100)
 434    , rank INTEGER NOT NULL DEFAULT '13'
 435    , charfield CHAR(10)
 436    , arrayfield INTEGER[]
 437  );
 438 EOS
 439     $dbh->do('set search_path=public,testschema,yetanothertestschema');
 440     $dbh->do('create sequence public.artist_artistid_seq'); #< in the public schema
 441     $dbh->do(<<EOS);
 442  CREATE TABLE unq_nextval_schema2.artist
 443  (
 444    artistid integer not null default nextval('public.artist_artistid_seq'::regclass) PRIMARY KEY
 445    , name VARCHAR(100)
 446    , rank INTEGER NOT NULL DEFAULT '13'
 447    , charfield CHAR(10)
 448    , arrayfield INTEGER[]
 449  );
 450 EOS
 451     $dbh->do('set search_path=testschema,public');
 452 }
 453
 454
 455
 456 sub drop_test_schema {
 457   my ( $dbh, $no_warn ) = @_;
 458
 459   return unless $dbh->ping;
 460
 461   for my $stat (
 462     'DROP TABLE unq_nextval_schema2.artist',
 463     'DROP SCHEMA unq_nextval_schema2',
 464     'DROP SEQUENCE public.artist_artistid_seq',
 465     'DROP TABLE unq_nextval_schema.artist',
 466     'DROP SCHEMA unq_nextval_schema',
 467     'DROP TABLE testschema.artist',
 468     'DROP TABLE testschema.casecheck',
 469     'DROP TABLE testschema.sequence_test',
 470     'DROP TABLE testschema.array_test',
 471     'DROP SEQUENCE pkid1_seq',
 472     'DROP SEQUENCE pkid2_seq',
 473     'DROP SEQUENCE nonpkid_seq',
 474     'DROP SCHEMA testschema',
 475     'DROP TABLE anothertestschema.artist',
 476     'DROP SCHEMA anothertestschema',
 477     'DROP TABLE yetanothertestschema.artist',
 478     'DROP SCHEMA yetanothertestschema',
 479   ) {
 480     eval { $dbh->do ($stat) };
 481     diag $@ if $@ && !$no_warn;
 482   }
 483 }
 484