t/73oracle_hq.t

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