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