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