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