t/73oracle_hq.t

   1 use strict;
   2 use warnings;
   3
   4 use Test::Exception;
   5 use Test::More;
   6 use DBIx::Class::Optional::Dependencies ();
   7 use lib qw(t/lib);
   8 use DBICTest::RunMode;
   9
  10 $ENV{NLS_SORT} = "BINARY";
  11 $ENV{NLS_COMP} = "BINARY";
  12 $ENV{NLS_LANG} = "AMERICAN";
  13
  14 my ($dsn,  $user,  $pass)  = @ENV{map { "DBICTEST_ORA_${_}" }  qw/DSN USER PASS/};
  15
  16 plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
  17  unless ($dsn && $user && $pass);
  18
  19 plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('rdbms_oracle')
  20   unless DBIx::Class::Optional::Dependencies->req_ok_for ('rdbms_oracle');
  21
  22 use DBICTest::Schema::Artist;
  23 BEGIN {
  24   DBICTest::Schema::Artist->add_column('parentid');
  25
  26   DBICTest::Schema::Artist->has_many(
  27     children => 'DBICTest::Schema::Artist',
  28     { 'foreign.parentid' => 'self.artistid' }
  29   );
  30
  31   DBICTest::Schema::Artist->belongs_to(
  32     parent => 'DBICTest::Schema::Artist',
  33     { 'foreign.artistid' => 'self.parentid' }
  34   );
  35 }
  36
  37 use DBICTest;
  38 use DBICTest::Schema;
  39
  40 my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
  41
  42 note "Oracle Version: " . $schema->storage->_server_info->{dbms_version};
  43
  44 my $dbh = $schema->storage->dbh;
  45 do_creates($dbh);
  46
  47 ### test hierarchical queries
  48 {
  49   $schema->resultset('Artist')->create ({
  50     name => 'root',
  51     rank => 1,
  52     cds => [],
  53     children => [
  54       {
  55         name => 'child1',
  56         rank => 2,
  57         children => [
  58           {
  59             name => 'grandchild',
  60             rank => 3,
  61             cds => [
  62               {
  63                 title => "grandchilds's cd" ,
  64                 year => '2008',
  65                 tracks => [
  66                   {
  67                     position => 1,
  68                     title => 'Track 1 grandchild',
  69                   }
  70                 ],
  71               }
  72             ],
  73             children => [
  74               {
  75                 name => 'greatgrandchild',
  76                 rank => 3,
  77               }
  78             ],
  79           }
  80         ],
  81       },
  82       {
  83         name => 'child2',
  84         rank => 3,
  85       },
  86     ],
  87   });
  88
  89   $schema->resultset('Artist')->create({
  90     name => 'cycle-root',
  91     children => [
  92       {
  93         name => 'cycle-child1',
  94         children => [ { name => 'cycle-grandchild' } ],
  95       },
  96       {
  97         name => 'cycle-child2'
  98       },
  99     ],
 100   });
 101
 102   $schema->resultset('Artist')->find({ name => 'cycle-root' })
 103     ->update({ parentid => { -ident => 'artistid' } });
 104
 105   # select the whole tree
 106   {
 107     my $rs = $schema->resultset('Artist')->search({}, {
 108       start_with => { name => 'root' },
 109       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 110     });
 111
 112     is_deeply (
 113       [ $rs->get_column ('name')->all ],
 114       [ qw/root child1 grandchild greatgrandchild child2/ ],
 115       'got artist tree',
 116     );
 117
 118     is( $rs->count, 5, 'Connect By count ok' );
 119   }
 120
 121   # use order siblings by statement
 122   SKIP: {
 123     # http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a85397/state21b.htm#2066123
 124     skip q{Oracle8i doesn't support ORDER SIBLINGS BY}, 1
 125       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 126
 127     my $rs = $schema->resultset('Artist')->search({}, {
 128       start_with => { name => 'root' },
 129       connect_by => { parentid => { -prior => { -ident =>  'artistid' } } },
 130       order_siblings_by => { -desc => 'name' },
 131     });
 132
 133     is_deeply (
 134       [ $rs->get_column ('name')->all ],
 135       [ qw/root child2 child1 grandchild greatgrandchild/ ],
 136       'Order Siblings By ok',
 137     );
 138   }
 139
 140   # get the root node
 141   {
 142     my $rs = $schema->resultset('Artist')->search({ parentid => undef }, {
 143       start_with => { name => 'root' },
 144       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 145     });
 146
 147     is_deeply(
 148       [ $rs->get_column('name')->all ],
 149       [ 'root' ],
 150       'found root node',
 151     );
 152   }
 153
 154   # combine a connect by with a join
 155   SKIP: {
 156     # http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a85397/state21b.htm#2066123
 157     skip q{Oracle8i doesn't support connect by with join}, 1
 158       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 159
 160     my $rs = $schema->resultset('Artist')->search(
 161       {'cds.title' => { -like => '%cd'} },
 162       {
 163         join => 'cds',
 164         start_with => { 'me.name' => 'root' },
 165         connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 166       }
 167     );
 168
 169     is_deeply(
 170       [ $rs->get_column('name')->all ],
 171       [ 'grandchild' ],
 172       'Connect By with a join result name ok'
 173     );
 174
 175     is( $rs->count, 1, 'Connect By with a join; count ok' );
 176   }
 177
 178   # combine a connect by with order_by
 179   {
 180     my $rs = $schema->resultset('Artist')->search({}, {
 181       start_with => { name => 'root' },
 182       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 183       order_by => { -asc => [ 'LEVEL', 'name' ] },
 184     });
 185
 186     # Don't use "$rs->get_column ('name')->all" they build a query arround the $rs.
 187     #   If $rs has a order by, the order by is in the subquery and this doesn't work with Oracle 8i.
 188     # TODO: write extra test and fix order by handling on Oracle 8i
 189     is_deeply (
 190       [ map { $_->[1] } $rs->cursor->all ],
 191       [ qw/root child1 child2 grandchild greatgrandchild/ ],
 192       'Connect By with a order_by - result name ok (without get_column)'
 193     );
 194
 195     SKIP: {
 196       skip q{Connect By with a order_by - result name ok (with get_column), Oracle8i doesn't support order by in a subquery},1
 197         if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 198       is_deeply (
 199         [  $rs->get_column ('name')->all ],
 200         [ qw/root child1 child2 grandchild greatgrandchild/ ],
 201         'Connect By with a order_by - result name ok (with get_column)'
 202       );
 203     }
 204   }
 205
 206
 207   # limit a connect by
 208   SKIP: {
 209     skip q{Oracle8i doesn't support order by in a subquery}, 1
 210       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 211
 212     my $rs = $schema->resultset('Artist')->search({}, {
 213       start_with => { name => 'root' },
 214       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 215       order_by => [ { -asc => 'name' }, {  -desc => 'artistid' } ],
 216       rows => 2,
 217     });
 218
 219     is_deeply (
 220       [ $rs->get_column ('name')->all ],
 221       [qw/child1 child2/],
 222       'LIMIT a Connect By query - correct names'
 223     );
 224
 225     is( $rs->count, 2, 'Connect By; LIMIT count ok' );
 226   }
 227
 228   # combine a connect_by with group_by and having
 229   # add some bindvals to make sure things still work
 230   {
 231     my $rs = $schema->resultset('Artist')->search({}, {
 232       select => \[ 'COUNT(rank) + ?', [ __cbind => 3 ] ],
 233       as => 'cnt',
 234       start_with => { name => 'root' },
 235       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 236       group_by => \[ 'rank + ? ', [ __gbind =>  1] ],
 237       having => \[ 'count(rank) < ?', [ cnt => 2 ] ],
 238     });
 239
 240     is_deeply (
 241       [ $rs->get_column ('cnt')->all ],
 242       [4, 4],
 243       'Group By a Connect By query - correct values'
 244     );
 245   }
 246
 247   # select the whole cycle tree without nocylce
 248   {
 249     my $rs = $schema->resultset('Artist')->search({}, {
 250       start_with => { name => 'cycle-root' },
 251       connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
 252     });
 253
 254     # ORA-01436:  CONNECT BY loop in user data
 255     throws_ok { $rs->get_column ('name')->all } qr/ORA-01436/,
 256       "connect by initify loop detection without nocycle";
 257   }
 258
 259   # select the whole cycle tree with nocylce
 260   SKIP: {
 261     # http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a85397/expressi.htm#1023748
 262     skip q{Oracle8i doesn't support connect by nocycle}, 1
 263       if $schema->storage->_server_info->{normalized_dbms_version} < 9;
 264
 265     my $rs = $schema->resultset('Artist')->search({}, {
 266       start_with => { name => 'cycle-root' },
 267       '+select'  => \ 'CONNECT_BY_ISCYCLE',
 268       '+as'      => [ 'connector' ],
 269       connect_by_nocycle => { parentid => { -prior => { -ident => 'artistid' } } },
 270     });
 271
 272     is_deeply (
 273       [ $rs->get_column ('name')->all ],
 274       [ qw/cycle-root cycle-child1 cycle-grandchild cycle-child2/ ],
 275       'got artist tree with nocycle (name)',
 276     );
 277     is_deeply (
 278       [ $rs->get_column ('connector')->all ],
 279       [ qw/1 0 0 0/ ],
 280       'got artist tree with nocycle (CONNECT_BY_ISCYCLE)',
 281     );
 282
 283     is( $rs->count, 4, 'Connect By Nocycle count ok' );
 284   }
 285 }
 286
 287 done_testing;
 288
 289 sub do_creates {
 290   my $dbh = shift;
 291
 292   eval {
 293     $dbh->do("DROP SEQUENCE artist_autoinc_seq");
 294     $dbh->do("DROP SEQUENCE artist_pk_seq");
 295     $dbh->do("DROP SEQUENCE cd_seq");
 296     $dbh->do("DROP SEQUENCE track_seq");
 297     $dbh->do("DROP TABLE artist");
 298     $dbh->do("DROP TABLE track");
 299     $dbh->do("DROP TABLE cd");
 300   };
 301
 302   $dbh->do("CREATE SEQUENCE artist_pk_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
 303   $dbh->do("CREATE SEQUENCE cd_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
 304   $dbh->do("CREATE SEQUENCE track_seq START WITH 1 MAXVALUE 999999 MINVALUE 0");
 305
 306   $dbh->do("CREATE TABLE artist (artistid NUMBER(12), parentid NUMBER(12), name VARCHAR(255), autoinc_col NUMBER(12), rank NUMBER(38), charfield VARCHAR2(10))");
 307   $dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))");
 308
 309   $dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))");
 310   $dbh->do("ALTER TABLE cd ADD (CONSTRAINT cd_pk PRIMARY KEY (cdid))");
 311
 312   $dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12) REFERENCES cd(cdid) DEFERRABLE, position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)");
 313   $dbh->do("ALTER TABLE track ADD (CONSTRAINT track_pk PRIMARY KEY (trackid))");
 314
 315   $dbh->do(qq{
 316     CREATE OR REPLACE TRIGGER artist_insert_trg_pk
 317     BEFORE INSERT ON artist
 318     FOR EACH ROW
 319       BEGIN
 320         IF :new.artistid IS NULL THEN
 321           SELECT artist_pk_seq.nextval
 322           INTO :new.artistid
 323           FROM DUAL;
 324         END IF;
 325       END;
 326   });
 327   $dbh->do(qq{
 328     CREATE OR REPLACE TRIGGER cd_insert_trg
 329     BEFORE INSERT OR UPDATE ON cd
 330     FOR EACH ROW
 331
 332       DECLARE
 333       tmpVar NUMBER;
 334
 335       BEGIN
 336         tmpVar := 0;
 337
 338         IF :new.cdid IS NULL THEN
 339           SELECT cd_seq.nextval
 340           INTO tmpVar
 341           FROM dual;
 342
 343           :new.cdid := tmpVar;
 344         END IF;
 345       END;
 346   });
 347   $dbh->do(qq{
 348     CREATE OR REPLACE TRIGGER track_insert_trg
 349     BEFORE INSERT ON track
 350     FOR EACH ROW
 351       BEGIN
 352         IF :new.trackid IS NULL THEN
 353           SELECT track_seq.nextval
 354           INTO :new.trackid
 355           FROM DUAL;
 356         END IF;
 357       END;
 358   });
 359 }
 360
 361 # clean up our mess
 362 END {
 363   if ($schema and my $dbh = $schema->storage->dbh) {
 364     eval { $dbh->do($_) } for (
 365       'DROP SEQUENCE artist_pk_seq',
 366       'DROP SEQUENCE cd_seq',
 367       'DROP SEQUENCE track_seq',
 368       'DROP TABLE artist',
 369       'DROP TABLE track',
 370       'DROP TABLE cd',
 371     );
 372   };
 373   undef $schema;
 374 }