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