Commit | Line | Data |
12e05c15 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::Exception; |
5 | use Test::More; |
1b658919 |
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 | |
199fbc45 |
12 | use DBIx::Class::Optional::Dependencies (); |
12e05c15 |
13 | use lib qw(t/lib); |
fcb7fcbb |
14 | |
994dc91b |
15 | $ENV{NLS_SORT} = "BINARY"; |
16 | $ENV{NLS_COMP} = "BINARY"; |
17 | $ENV{NLS_LANG} = "AMERICAN"; |
18 | |
12e05c15 |
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 | |
e6983054 |
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 | |
2c2bc4e5 |
27 | { |
28 | require DBICTest::Schema::Artist; |
12e05c15 |
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 | |
8d6b1478 |
42 | use DBICTest; |
12e05c15 |
43 | |
2c2bc4e5 |
44 | my $schema = DBICTest->connect_schema($dsn, $user, $pass); |
12e05c15 |
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 | |
12e05c15 |
116 | is_deeply ( |
117 | [ $rs->get_column ('name')->all ], |
118 | [ qw/root child1 grandchild greatgrandchild child2/ ], |
119 | 'got artist tree', |
120 | ); |
121 | |
12e05c15 |
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 | |
12e05c15 |
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 | |
12e05c15 |
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 | |
12e05c15 |
173 | is_deeply( |
174 | [ $rs->get_column('name')->all ], |
175 | [ 'grandchild' ], |
176 | 'Connect By with a join result name ok' |
177 | ); |
178 | |
12e05c15 |
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 | |
12e05c15 |
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' } } }, |
6a6394f1 |
219 | order_by => [ { -asc => 'name' }, { -desc => 'artistid' } ], |
12e05c15 |
220 | rows => 2, |
221 | }); |
222 | |
12e05c15 |
223 | is_deeply ( |
224 | [ $rs->get_column ('name')->all ], |
225 | [qw/child1 child2/], |
226 | 'LIMIT a Connect By query - correct names' |
227 | ); |
228 | |
12e05c15 |
229 | is( $rs->count, 2, 'Connect By; LIMIT count ok' ); |
230 | } |
231 | |
232 | # combine a connect_by with group_by and having |
55d02972 |
233 | # add some bindvals to make sure things still work |
12e05c15 |
234 | { |
235 | my $rs = $schema->resultset('Artist')->search({}, { |
55d02972 |
236 | select => \[ 'COUNT(rank) + ?', [ __cbind => 3 ] ], |
237 | as => 'cnt', |
12e05c15 |
238 | start_with => { name => 'root' }, |
239 | connect_by => { parentid => { -prior => { -ident => 'artistid' } } }, |
55d02972 |
240 | group_by => \[ 'rank + ? ', [ __gbind => 1] ], |
12e05c15 |
241 | having => \[ 'count(rank) < ?', [ cnt => 2 ] ], |
242 | }); |
243 | |
12e05c15 |
244 | is_deeply ( |
245 | [ $rs->get_column ('cnt')->all ], |
55d02972 |
246 | [4, 4], |
12e05c15 |
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 | |
12e05c15 |
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 | |
12e05c15 |
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 { |
65d35121 |
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 | ); |
12e05c15 |
376 | }; |
65d35121 |
377 | undef $schema; |
12e05c15 |
378 | } |