t/73oracle_hq.t

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