Not sure what I was thinking, but 18637ebb never worked :/
[dbsrgits/DBIx-Class.git] / 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 }