t/73oracle_hq.t

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