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