Fix t/54taint.t failures on perl-in-hell-in-space
[dbsrgits/DBIx-Class.git] / t / 73oracle_hq.t
CommitLineData
12e05c15 1use strict;
2use warnings;
3
4use Test::Exception;
5use 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.
9BEGIN { $ENV{DBIC_SHUFFLE_UNORDERED_RESULTSETS} = 0 }
10
11
199fbc45 12use DBIx::Class::Optional::Dependencies ();
12e05c15 13use lib qw(t/lib);
fcb7fcbb 14
994dc91b 15$ENV{NLS_SORT} = "BINARY";
16$ENV{NLS_COMP} = "BINARY";
17$ENV{NLS_LANG} = "AMERICAN";
18
12e05c15 19my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/};
20
21plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.'
22 unless ($dsn && $user && $pass);
23
e6983054 24plan 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
12e05c15 27use DBICTest::Schema::Artist;
28BEGIN {
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 42use DBICTest;
12e05c15 43use DBICTest::Schema;
44
45my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
46
47note "Oracle Version: " . $schema->storage->_server_info->{dbms_version};
48
49my $dbh = $schema->storage->dbh;
50do_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
12e05c15 117 is_deeply (
118 [ $rs->get_column ('name')->all ],
119 [ qw/root child1 grandchild greatgrandchild child2/ ],
120 'got artist tree',
121 );
122
12e05c15 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
12e05c15 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
12e05c15 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
12e05c15 174 is_deeply(
175 [ $rs->get_column('name')->all ],
176 [ 'grandchild' ],
177 'Connect By with a join result name ok'
178 );
179
12e05c15 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
12e05c15 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' } } },
6a6394f1 220 order_by => [ { -asc => 'name' }, { -desc => 'artistid' } ],
12e05c15 221 rows => 2,
222 });
223
12e05c15 224 is_deeply (
225 [ $rs->get_column ('name')->all ],
226 [qw/child1 child2/],
227 'LIMIT a Connect By query - correct names'
228 );
229
12e05c15 230 is( $rs->count, 2, 'Connect By; LIMIT count ok' );
231 }
232
233 # combine a connect_by with group_by and having
55d02972 234 # add some bindvals to make sure things still work
12e05c15 235 {
236 my $rs = $schema->resultset('Artist')->search({}, {
55d02972 237 select => \[ 'COUNT(rank) + ?', [ __cbind => 3 ] ],
238 as => 'cnt',
12e05c15 239 start_with => { name => 'root' },
240 connect_by => { parentid => { -prior => { -ident => 'artistid' } } },
55d02972 241 group_by => \[ 'rank + ? ', [ __gbind => 1] ],
12e05c15 242 having => \[ 'count(rank) < ?', [ cnt => 2 ] ],
243 });
244
12e05c15 245 is_deeply (
246 [ $rs->get_column ('cnt')->all ],
55d02972 247 [4, 4],
12e05c15 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
12e05c15 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
12e05c15 288 is( $rs->count, 4, 'Connect By Nocycle count ok' );
289 }
290}
291
292done_testing;
293
294sub 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
367END {
65d35121 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 );
12e05c15 377 };
65d35121 378 undef $schema;
12e05c15 379}