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