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