t/73oracle.t

   1 {
   2   package    # hide from PAUSE
   3     DBICTest::Schema::ArtistFQN;
   4
   5   use base 'DBIx::Class::Core';
   6
   7   __PACKAGE__->table(
   8     defined $ENV{DBICTEST_ORA_USER}
   9       ? (uc $ENV{DBICTEST_ORA_USER}) . '.artist'
  10       : 'artist'
  11   );
  12   __PACKAGE__->add_columns(
  13     'artistid' => {
  14       data_type         => 'integer',
  15       is_auto_increment => 1,
  16     },
  17     'name' => {
  18       data_type   => 'varchar',
  19       size        => 100,
  20       is_nullable => 1,
  21     },
  22     'autoinc_col' => {
  23       data_type         => 'integer',
  24       is_auto_increment => 1,
  25     },
  26   );
  27   __PACKAGE__->set_primary_key('artistid');
  28
  29   1;
  30 }
  31
  32 use strict;
  33 use warnings;
  34
  35 use Test::Exception;
  36 use Test::More;
  37
  38 use lib qw(t/lib);
  39 use DBICTest;
  40 use DBIC::SqlMakerTest;
  41
  42 my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_ORA_${_}" }  qw/DSN USER PASS/};
  43
  44 # optional:
  45 my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN USER PASS/};
  46
  47 plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
  48   unless ($dsn && $user && $pass);
  49
  50 DBICTest::Schema->load_classes('ArtistFQN');
  51
  52 # This is in Core now, but it's here just to test that it doesn't break
  53 DBICTest::Schema::Artist->load_components('PK::Auto');
  54 # These are compat shims for PK::Auto...
  55 DBICTest::Schema::CD->load_components('PK::Auto::Oracle');
  56 DBICTest::Schema::Track->load_components('PK::Auto::Oracle');
  57
  58
  59 ##########
  60 # recyclebin sometimes comes in the way
  61 my $on_connect_sql = ["ALTER SESSION SET recyclebin = OFF"];
  62
  63 # iterate all tests on following options
  64 my @tryopt = (
  65   { on_connect_do => $on_connect_sql },
  66   { quote_char => '"', on_connect_do => $on_connect_sql, },
  67 );
  68
  69 # keep a database handle open for cleanup
  70 my $dbh;
  71
  72 for my $opt (@tryopt) {
  73   # clean all cached sequences from previous run
  74   for (map { values %{DBICTest::Schema->source($_)->columns_info} } (qw/Artist CD Track/) ) {
  75     delete $_->{sequence};
  76   }
  77
  78   my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opt);
  79   my $q = $schema -> storage -> sql_maker -> quote_char || '';
  80
  81   $dbh = $schema->storage->dbh;
  82
  83   do_creates($dbh, $q);
  84
  85 # test primary key handling with multiple triggers
  86   my ($new, $seq);
  87
  88   $new = $schema->resultset('Artist')->create({ name => 'foo' });
  89   is($new->artistid, 1, "Oracle Auto-PK worked for standard sqlt-like trigger");
  90   $seq = $new->result_source->column_info('artistid')->{sequence};
  91   $seq = $$seq if ref $seq;
  92   like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger');
  93
  94   $new = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' });
  95   is($new->cdid, 1, 'Oracle Auto-PK worked - using scalar ref as table name/custom weird trigger');
  96   $seq = $new->result_source->column_info('cdid')->{sequence};
  97   $seq = $$seq if ref $seq;
  98   like ($seq, qr/\.${q}cd_seq${q}$/, 'Correct PK sequence selected for custom trigger');
  99
 100
 101 # test PKs again with fully-qualified table name
 102   my $artistfqn_rs = $schema->resultset('ArtistFQN');
 103   my $artist_rsrc = $artistfqn_rs->result_source;
 104
 105   delete $artist_rsrc->column_info('artistid')->{sequence};
 106   $new = $artistfqn_rs->create( { name => 'bar' } );
 107
 108   is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" );
 109
 110
 111   delete $artist_rsrc->column_info('artistid')->{sequence};
 112   $new = $artistfqn_rs->create( { name => 'bar', autoinc_col => 1000 } );
 113
 114   is( $new->artistid, 3, "Oracle Auto-PK worked with fully-qualified tablename" );
 115   is( $new->autoinc_col, 1000, "Oracle Auto-Inc overruled with fully-qualified tablename");
 116   $seq = $new->result_source->column_info('artistid')->{sequence};
 117   $seq = $$seq if ref $seq;
 118   like ($seq, qr/\.${q}artist_pk_seq${q}$/, 'Correct PK sequence selected for sqlt-like trigger');
 119
 120
 121 # test LIMIT support
 122   for (1..6) {
 123     $schema->resultset('Artist')->create({ name => 'Artist ' . $_ });
 124   }
 125   my $it = $schema->resultset('Artist')->search( { name => { -like => 'Artist %' } }, {
 126     rows => 3,
 127     offset => 4,
 128     order_by => 'artistid'
 129   });
 130
 131   is( $it->count, 2, "LIMIT count past end of RS ok" );
 132   is( $it->next->name, "Artist 5", "iterator->next ok" );
 133   is( $it->next->name, "Artist 6", "iterator->next ok" );
 134   is( $it->next, undef, "next past end of resultset ok" );
 135
 136
 137 # test identifiers over the 30 char limit
 138   lives_ok {
 139     my @results = $schema->resultset('CD')->search(undef, {
 140       prefetch => 'very_long_artist_relationship',
 141       rows => 3,
 142       offset => 0,
 143     })->all;
 144     ok( scalar @results > 0, 'limit with long identifiers returned something');
 145   } 'limit with long identifiers executed successfully';
 146
 147
 148 # test rel names over the 30 char limit
 149   my $query = $schema->resultset('Artist')->search({
 150     artistid => 1
 151   }, {
 152     prefetch => 'cds_very_very_very_long_relationship_name'
 153   });
 154
 155   lives_and {
 156     is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
 157   } 'query with rel name over 30 chars survived and worked';
 158
 159   # rel name over 30 char limit with user condition
 160   # This requires walking the SQLA data structure.
 161   {
 162     local $TODO = 'user condition on rel longer than 30 chars';
 163
 164     $query = $schema->resultset('Artist')->search({
 165       'cds_very_very_very_long_relationship_name.title' => 'EP C'
 166     }, {
 167       prefetch => 'cds_very_very_very_long_relationship_name'
 168     });
 169
 170     lives_and {
 171       is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1
 172     } 'query with rel name over 30 chars and user condition survived and worked';
 173   }
 174
 175
 176 # test join with row count ambiguity
 177   my $cd = $schema->resultset('CD')->next;
 178   my $track = $cd->create_related('tracks', { position => 1, title => 'Track1'} );
 179   my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, {
 180     join => 'cd', rows => 2
 181   });
 182
 183   ok(my $row = $tjoin->next);
 184
 185   is($row->title, 'Track1', "ambiguous column ok");
 186
 187
 188
 189 # check count distinct with multiple columns
 190   my $other_track = $schema->resultset('Track')->create({ cd => $cd->cdid, position => 1, title => 'Track2' });
 191
 192   my $tcount = $schema->resultset('Track')->search(
 193     {},
 194     {
 195       select => [ qw/position title/ ],
 196       distinct => 1,
 197     }
 198   );
 199   is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
 200
 201   $tcount = $schema->resultset('Track')->search(
 202     {},
 203     {
 204       columns => [ qw/position title/ ],
 205       distinct => 1,
 206     }
 207   );
 208   is($tcount->count, 2, 'multiple column COUNT DISTINCT ok');
 209
 210   $tcount = $schema->resultset('Track')->search(
 211     {},
 212     {
 213       group_by => [ qw/position title/ ]
 214     }
 215   );
 216   is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok');
 217
 218
 219 # check group_by
 220   my $g_rs = $schema->resultset('Track')->search( undef, { columns=>[qw/trackid position/], group_by=> [ qw/trackid position/ ] , rows => 2, offset => 1 });
 221   is( scalar $g_rs->all, 1, "Group by with limit OK" );
 222
 223
 224 # test with_deferred_fk_checks
 225   lives_ok {
 226     $schema->storage->with_deferred_fk_checks(sub {
 227       $schema->resultset('Track')->create({
 228         trackid => 999, cd => 999, position => 1, title => 'deferred FK track'
 229       });
 230       $schema->resultset('CD')->create({
 231         artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd'
 232       });
 233     });
 234   } 'with_deferred_fk_checks code survived';
 235
 236   is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track',
 237     'code in with_deferred_fk_checks worked';
 238
 239   throws_ok {
 240     $schema->resultset('Track')->create({
 241       trackid => 1, cd => 9999, position => 1, title => 'Track1'
 242     });
 243   } qr/constraint/i, 'with_deferred_fk_checks is off';
 244
 245
 246 # test auto increment using sequences WITHOUT triggers
 247   for (1..5) {
 248     my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' });
 249     is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key");
 250     is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key");
 251     is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key");
 252   }
 253   my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 });
 254   is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually");
 255
 256
 257 # test BLOBs
 258   SKIP: {
 259   TODO: {
 260     my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
 261     $binstr{'large'} = $binstr{'small'} x 1024;
 262
 263     my $maxloblen = length $binstr{'large'};
 264     note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
 265     local $dbh->{'LongReadLen'} = $maxloblen;
 266
 267     my $rs = $schema->resultset('BindType');
 268     my $id = 0;
 269
 270     if ($DBD::Oracle::VERSION eq '1.23') {
 271       throws_ok { $rs->create({ id => 1, blob => $binstr{large} }) }
 272         qr/broken/,
 273         'throws on blob insert with DBD::Oracle == 1.23';
 274
 275       skip 'buggy BLOB support in DBD::Oracle 1.23', 7;
 276     }
 277
 278     # disable BLOB mega-output
 279     my $orig_debug = $schema->storage->debug;
 280     $schema->storage->debug (0);
 281
 282     local $TODO = 'Something is confusing column bindtype assignment when quotes are active'
 283       if $q;
 284
 285     foreach my $type (qw( blob clob )) {
 286       foreach my $size (qw( small large )) {
 287         $id++;
 288
 289         lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
 290         "inserted $size $type without dying";
 291         ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
 292       }
 293     }
 294
 295     $schema->storage->debug ($orig_debug);
 296   }}
 297
 298
 299 # test sequence detection from a different schema
 300   SKIP: {
 301   TODO: {
 302     skip ((join '',
 303       'Set DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS to a *DIFFERENT* Oracle user',
 304       ' to run the cross-schema autoincrement test.'),
 305     1) unless $dsn2 && $user2 && $user2 ne $user;
 306
 307     # Oracle8i Reference Release 2 (8.1.6)
 308     #   http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a76961/ch294.htm#993
 309     # Oracle Database Reference 10g Release 2 (10.2)
 310     #   http://download.oracle.com/docs/cd/B19306_01/server.102/b14237/statviews_2107.htm#sthref1297
 311     local $TODO = "On Oracle8i all_triggers view is empty, i don't yet know why..."
 312       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 313
 314     my $schema2 = DBICTest::Schema->connect($dsn2, $user2, $pass2, $opt);
 315
 316
 317     my $schema1_dbh  = $schema->storage->dbh;
 318     $schema1_dbh->do("GRANT INSERT ON ${q}artist${q} TO " . uc $user2);
 319     $schema1_dbh->do("GRANT SELECT ON ${q}artist_pk_seq${q} TO " . uc $user2);
 320
 321
 322     my $rs = $schema2->resultset('ArtistFQN');
 323     delete $rs->result_source->column_info('artistid')->{sequence};
 324
 325     # first test with unquoted (default) sequence name in trigger body
 326     lives_and {
 327       my $row = $rs->create({ name => 'From Different Schema' });
 328       ok $row->artistid;
 329     } 'used autoinc sequence across schemas';
 330
 331     # now quote the sequence name (do_creates always uses an lc name)
 332     my $q_seq = $q
 333       ? '"artist_pk_seq"'
 334       : '"ARTIST_PK_SEQ"'
 335     ;
 336     delete $rs->result_source->column_info('artistid')->{sequence};
 337     $schema1_dbh->do(qq{
 338       CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_pk${q}
 339       BEFORE INSERT ON ${q}artist${q}
 340       FOR EACH ROW
 341       BEGIN
 342         IF :new.${q}artistid${q} IS NULL THEN
 343           SELECT $q_seq.nextval
 344           INTO :new.${q}artistid${q}
 345           FROM DUAL;
 346         END IF;
 347       END;
 348     });
 349
 350
 351     lives_and {
 352       my $row = $rs->create({ name => 'From Different Schema With Quoted Sequence' });
 353       ok $row->artistid;
 354     } 'used quoted autoinc sequence across schemas';
 355
 356     my $schema_name = uc $user;
 357
 358     is_deeply $rs->result_source->column_info('artistid')->{sequence},
 359       \qq|${schema_name}.$q_seq|,
 360       'quoted sequence name correctly extracted';
 361   }}
 362
 363   do_clean ($dbh);
 364 }
 365
 366 done_testing;
 367
 368 sub do_creates {
 369   my ($dbh, $q) = @_;
 370
 371   do_clean($dbh);
 372
 373   $dbh->do("CREATE SEQUENCE ${q}artist_autoinc_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
 374   $dbh->do("CREATE SEQUENCE ${q}artist_pk_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
 375   $dbh->do("CREATE SEQUENCE ${q}cd_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
 376   $dbh->do("CREATE SEQUENCE ${q}track_seq${q} START WITH 1 MAXVALUE 999999 MINVALUE 0");
 377
 378   $dbh->do("CREATE SEQUENCE ${q}nonpkid_seq${q} START WITH 20 MAXVALUE 999999 MINVALUE 0");
 379   # this one is always quoted as per manually specified sequence =>
 380   $dbh->do('CREATE SEQUENCE "pkid1_seq" START WITH 1 MAXVALUE 999999 MINVALUE 0');
 381   # this one is always unquoted as per manually specified sequence =>
 382   $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0");
 383
 384   $dbh->do("CREATE TABLE ${q}artist${q} (${q}artistid${q} NUMBER(12), ${q}name${q} VARCHAR(255), ${q}autoinc_col${q} NUMBER(12), ${q}rank${q} NUMBER(38), ${q}charfield${q} VARCHAR2(10))");
 385   $dbh->do("ALTER TABLE ${q}artist${q} ADD (CONSTRAINT ${q}artist_pk${q} PRIMARY KEY (${q}artistid${q}))");
 386
 387   $dbh->do("CREATE TABLE ${q}sequence_test${q} (${q}pkid1${q} NUMBER(12), ${q}pkid2${q} NUMBER(12), ${q}nonpkid${q} NUMBER(12), ${q}name${q} VARCHAR(255))");
 388   $dbh->do("ALTER TABLE ${q}sequence_test${q} ADD (CONSTRAINT ${q}sequence_test_constraint${q} PRIMARY KEY (${q}pkid1${q}, ${q}pkid2${q}))");
 389
 390   # table cd will be unquoted => Oracle will see it as uppercase
 391   $dbh->do("CREATE TABLE cd (${q}cdid${q} NUMBER(12), ${q}artist${q} NUMBER(12), ${q}title${q} VARCHAR(255), ${q}year${q} VARCHAR(4), ${q}genreid${q} NUMBER(12), ${q}single_track${q} NUMBER(12))");
 392   $dbh->do("ALTER TABLE cd ADD (CONSTRAINT ${q}cd_pk${q} PRIMARY KEY (${q}cdid${q}))");
 393
 394   $dbh->do("CREATE TABLE ${q}track${q} (${q}trackid${q} NUMBER(12), ${q}cd${q} NUMBER(12) REFERENCES CD(${q}cdid${q}) DEFERRABLE, ${q}position${q} NUMBER(12), ${q}title${q} VARCHAR(255), ${q}last_updated_on${q} DATE, ${q}last_updated_at${q} DATE, ${q}small_dt${q} DATE)");
 395   $dbh->do("ALTER TABLE ${q}track${q} ADD (CONSTRAINT ${q}track_pk${q} PRIMARY KEY (${q}trackid${q}))");
 396
 397   $dbh->do("CREATE TABLE ${q}bindtype_test${q} (${q}id${q} integer NOT NULL PRIMARY KEY, ${q}bytea${q} integer NULL, ${q}blob${q} blob NULL, ${q}clob${q} clob NULL)");
 398
 399   $dbh->do(qq{
 400     CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_auto${q}
 401     BEFORE INSERT ON ${q}artist${q}
 402     FOR EACH ROW
 403     BEGIN
 404       IF :new.${q}autoinc_col${q} IS NULL THEN
 405         SELECT ${q}artist_autoinc_seq${q}.nextval
 406         INTO :new.${q}autoinc_col${q}
 407         FROM DUAL;
 408       END IF;
 409     END;
 410   });
 411
 412   $dbh->do(qq{
 413     CREATE OR REPLACE TRIGGER ${q}artist_insert_trg_pk${q}
 414     BEFORE INSERT ON ${q}artist${q}
 415     FOR EACH ROW
 416     BEGIN
 417       IF :new.${q}artistid${q} IS NULL THEN
 418         SELECT ${q}artist_pk_seq${q}.nextval
 419         INTO :new.${q}artistid${q}
 420         FROM DUAL;
 421       END IF;
 422     END;
 423   });
 424
 425   $dbh->do(qq{
 426     CREATE OR REPLACE TRIGGER ${q}cd_insert_trg${q}
 427     BEFORE INSERT OR UPDATE ON cd
 428     FOR EACH ROW
 429
 430     DECLARE
 431     tmpVar NUMBER;
 432
 433     BEGIN
 434       tmpVar := 0;
 435
 436       IF :new.${q}cdid${q} IS NULL THEN
 437         SELECT ${q}cd_seq${q}.nextval
 438         INTO tmpVar
 439         FROM dual;
 440
 441         :new.${q}cdid${q} := tmpVar;
 442       END IF;
 443     END;
 444   });
 445
 446   $dbh->do(qq{
 447     CREATE OR REPLACE TRIGGER ${q}track_insert_trg${q}
 448     BEFORE INSERT ON ${q}track${q}
 449     FOR EACH ROW
 450     BEGIN
 451       IF :new.${q}trackid${q} IS NULL THEN
 452         SELECT ${q}track_seq${q}.nextval
 453         INTO :new.${q}trackid${q}
 454         FROM DUAL;
 455       END IF;
 456     END;
 457   });
 458 }
 459
 460 # clean up our mess
 461 sub do_clean {
 462
 463   my $dbh = shift || return;
 464
 465   for my $q ('', '"') {
 466     my @clean = (
 467       "DROP TRIGGER ${q}track_insert_trg${q}",
 468       "DROP TRIGGER ${q}cd_insert_trg${q}",
 469       "DROP TRIGGER ${q}artist_insert_trg_auto${q}",
 470       "DROP TRIGGER ${q}artist_insert_trg_pk${q}",
 471       "DROP SEQUENCE ${q}nonpkid_seq${q}",
 472       "DROP SEQUENCE ${q}pkid2_seq${q}",
 473       "DROP SEQUENCE ${q}pkid1_seq${q}",
 474       "DROP SEQUENCE ${q}track_seq${q}",
 475       "DROP SEQUENCE ${q}cd_seq${q}",
 476       "DROP SEQUENCE ${q}artist_autoinc_seq${q}",
 477       "DROP SEQUENCE ${q}artist_pk_seq${q}",
 478       "DROP TABLE ${q}bindtype_test${q}",
 479       "DROP TABLE ${q}sequence_test${q}",
 480       "DROP TABLE ${q}track${q}",
 481       "DROP TABLE ${q}cd${q}",
 482       "DROP TABLE ${q}artist${q}",
 483     );
 484     eval { $dbh -> do ($_) } for @clean;
 485   }
 486 }
 487
 488 END {
 489   if ($dbh) {
 490     local $SIG{__WARN__} = sub {};
 491     do_clean($dbh);
 492     $dbh->disconnect;
 493   }
 494 }