Commit | Line | Data |
cb464582 |
1 | { |
2 | package # hide from PAUSE |
3 | DBICTest::Schema::ArtistFQN; |
4 | |
5 | use base 'DBIx::Class::Core'; |
6 | |
7 | __PACKAGE__->table( |
8 | defined $ENV{DBICTEST_ORA_USER} |
9 | ? $ENV{DBICTEST_ORA_USER} . '.artist' |
10 | : 'artist' |
11 | ); |
12 | __PACKAGE__->add_columns( |
13 | 'artistid' => { |
14 | data_type => 'integer', |
15 | is_auto_increment => 1, |
16 | }, |
17 | 'name' => { |
18 | data_type => 'varchar', |
19 | size => 100, |
20 | is_nullable => 1, |
21 | }, |
ab4f4e4c |
22 | 'autoinc_col' => { |
23 | data_type => 'integer', |
24 | is_auto_increment => 1, |
25 | }, |
cb464582 |
26 | ); |
27 | __PACKAGE__->set_primary_key('artistid'); |
28 | |
29 | 1; |
30 | } |
31 | |
70350518 |
32 | use strict; |
e6dd7b42 |
33 | use warnings; |
70350518 |
34 | |
5db2758d |
35 | use Test::Exception; |
70350518 |
36 | use Test::More; |
ab6e0924 |
37 | |
70350518 |
38 | use lib qw(t/lib); |
39 | use DBICTest; |
8ce8340f |
40 | use DBIC::SqlMakerTest; |
0567538f |
41 | |
df6e3f5c |
42 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; |
43 | |
44 | # optional: |
9d7d2f00 |
45 | my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_ORA_EXTRAUSER_${_}" } qw/DSN USER PASS/}; |
0567538f |
46 | |
12e05c15 |
47 | plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test.' |
0567538f |
48 | unless ($dsn && $user && $pass); |
49 | |
cb464582 |
50 | DBICTest::Schema->load_classes('ArtistFQN'); |
9900b569 |
51 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
0567538f |
52 | |
ba12b23f |
53 | note "Oracle Version: " . $schema->storage->_server_info->{dbms_version}; |
54 | |
3ff5b740 |
55 | my $dbh = $schema->storage->dbh; |
0567538f |
56 | |
df6e3f5c |
57 | do_creates($dbh); |
0567538f |
58 | |
3ff5b740 |
59 | # This is in Core now, but it's here just to test that it doesn't break |
60 | $schema->class('Artist')->load_components('PK::Auto'); |
61 | # These are compat shims for PK::Auto... |
62 | $schema->class('CD')->load_components('PK::Auto::Oracle'); |
63 | $schema->class('Track')->load_components('PK::Auto::Oracle'); |
0567538f |
64 | |
ab4f4e4c |
65 | |
66 | # test primary key handling with multiple triggers |
3ff5b740 |
67 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
6f5f880d |
68 | is($new->artistid, 1, "Oracle Auto-PK worked for sqlt-like trigger"); |
0567538f |
69 | |
6f5f880d |
70 | like ($new->result_source->column_info('artistid')->{sequence}, qr/\.artist_pk_seq$/, 'Correct PK sequence selected for sqlt-like trigger'); |
71 | |
72 | $new = $schema->resultset('CD')->create({ artist => 1, title => 'foo', year => '2003' }); |
73 | is($new->cdid, 1, "Oracle Auto-PK worked for custom trigger"); |
74 | |
75 | like ($new->result_source->column_info('cdid')->{sequence}, qr/\.cd_seq$/, 'Correct PK sequence selected for custom trigger'); |
e6dd7b42 |
76 | |
cb464582 |
77 | # test again with fully-qualified table name |
ab4f4e4c |
78 | my $artistfqn_rs = $schema->resultset('ArtistFQN'); |
79 | my $artist_rsrc = $artistfqn_rs->result_source; |
80 | |
81 | delete $artist_rsrc->column_info('artistid')->{sequence}; |
82 | |
83 | $new = $artistfqn_rs->create( { name => 'bar' } ); |
cb464582 |
84 | is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); |
85 | |
ab4f4e4c |
86 | delete $artist_rsrc->column_info('artistid')->{sequence}; |
87 | |
88 | $new = $artistfqn_rs->create( { name => 'bar', autoinc_col => 1000 } ); |
89 | is( $new->artistid, 3, "Oracle Auto-PK worked with fully-qualified tablename" ); |
90 | is( $new->autoinc_col, 1000, "Oracle Auto-Inc overruled with fully-qualified tablename"); |
91 | |
92 | like ($artist_rsrc->column_info('artistid')->{sequence}, qr/\.artist_pk_seq$/, 'Still correct PK sequence'); |
93 | |
94 | # test LIMIT support |
95 | for (1..6) { |
96 | $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
97 | } |
98 | my $it = $schema->resultset('Artist')->search( { name => { -like => 'Artist %' }}, |
99 | { rows => 3, |
100 | offset => 4, |
101 | order_by => 'artistid' } |
102 | ); |
103 | is( $it->count, 2, "LIMIT count past end of RS ok" ); |
104 | is( $it->next->name, "Artist 5", "iterator->next ok" ); |
105 | is( $it->next->name, "Artist 6", "iterator->next ok" ); |
106 | is( $it->next, undef, "next past end of resultset ok" ); |
107 | |
108 | my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); |
6f5f880d |
109 | is($cd->cdid, 2, "Oracle Auto-PK worked - using scalar ref as table name"); |
ab4f4e4c |
110 | |
62d4dbae |
111 | # test rel names over the 30 char limit |
6c0230de |
112 | { |
ab4f4e4c |
113 | my $query = $schema->resultset('Artist')->search({ |
114 | artistid => 1 |
6c0230de |
115 | }, { |
116 | prefetch => 'cds_very_very_very_long_relationship_name' |
117 | }); |
118 | |
119 | lives_and { |
6f5f880d |
120 | is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 2 |
ab4f4e4c |
121 | } 'query with rel name over 30 chars survived and worked'; |
122 | |
123 | # rel name over 30 char limit with user condition |
124 | # This requires walking the SQLA data structure. |
125 | { |
126 | local $TODO = 'user condition on rel longer than 30 chars'; |
127 | |
128 | $query = $schema->resultset('Artist')->search({ |
129 | 'cds_very_very_very_long_relationship_name.title' => 'EP C' |
130 | }, { |
131 | prefetch => 'cds_very_very_very_long_relationship_name' |
132 | }); |
133 | |
134 | lives_and { |
135 | is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 |
136 | } 'query with rel name over 30 chars and user condition survived and worked'; |
137 | } |
6c0230de |
138 | } |
139 | |
9900b569 |
140 | # test join with row count ambiguity |
d2a3958e |
141 | |
c0024355 |
142 | my $track = $schema->resultset('Track')->create({ cd => $cd->cdid, |
9900b569 |
143 | position => 1, title => 'Track1' }); |
3ff5b740 |
144 | my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, |
2660b14e |
145 | { join => 'cd', |
146 | rows => 2 } |
147 | ); |
148 | |
d2a3958e |
149 | ok(my $row = $tjoin->next); |
150 | |
151 | is($row->title, 'Track1', "ambiguous column ok"); |
2660b14e |
152 | |
286f32b3 |
153 | # check count distinct with multiple columns |
c0024355 |
154 | my $other_track = $schema->resultset('Track')->create({ cd => $cd->cdid, position => 1, title => 'Track2' }); |
11d68671 |
155 | |
3ff5b740 |
156 | my $tcount = $schema->resultset('Track')->search( |
11d68671 |
157 | {}, |
158 | { |
159 | select => [ qw/position title/ ], |
160 | distinct => 1, |
161 | } |
162 | ); |
f12f0d97 |
163 | is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); |
11d68671 |
164 | |
165 | $tcount = $schema->resultset('Track')->search( |
166 | {}, |
167 | { |
168 | columns => [ qw/position title/ ], |
169 | distinct => 1, |
170 | } |
171 | ); |
f12f0d97 |
172 | is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); |
286f32b3 |
173 | |
11d68671 |
174 | $tcount = $schema->resultset('Track')->search( |
175 | {}, |
e6dd7b42 |
176 | { |
11d68671 |
177 | group_by => [ qw/position title/ ] |
178 | } |
179 | ); |
f12f0d97 |
180 | is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok'); |
2660b14e |
181 | |
e8e971f2 |
182 | { |
183 | my $rs = $schema->resultset('Track')->search( undef, { columns=>[qw/trackid position/], group_by=> [ qw/trackid position/ ] , rows => 2, offset=>1 }); |
184 | my @results = $rs->all; |
185 | is( scalar @results, 1, "Group by with limit OK" ); |
186 | } |
187 | |
bd691933 |
188 | # test identifiers over the 30 char limit |
189 | { |
190 | lives_ok { |
191 | my @results = $schema->resultset('CD')->search(undef, { |
192 | prefetch => 'very_long_artist_relationship', |
193 | rows => 3, |
194 | offset => 0, |
195 | })->all; |
196 | ok( scalar @results > 0, 'limit with long identifiers returned something'); |
197 | } 'limit with long identifiers executed successfully'; |
198 | } |
199 | |
b7b18f32 |
200 | # test with_deferred_fk_checks |
201 | lives_ok { |
202 | $schema->storage->with_deferred_fk_checks(sub { |
203 | $schema->resultset('Track')->create({ |
204 | trackid => 999, cd => 999, position => 1, title => 'deferred FK track' |
205 | }); |
206 | $schema->resultset('CD')->create({ |
207 | artist => 1, cdid => 999, year => '2003', title => 'deferred FK cd' |
208 | }); |
209 | }); |
210 | } 'with_deferred_fk_checks code survived'; |
211 | |
212 | is eval { $schema->resultset('Track')->find(999)->title }, 'deferred FK track', |
213 | 'code in with_deferred_fk_checks worked'; |
214 | |
215 | throws_ok { |
216 | $schema->resultset('Track')->create({ |
217 | trackid => 1, cd => 9999, position => 1, title => 'Track1' |
218 | }); |
219 | } qr/constraint/i, 'with_deferred_fk_checks is off'; |
220 | |
ccd6f984 |
221 | # test auto increment using sequences WITHOUT triggers |
39b8d119 |
222 | for (1..5) { |
223 | my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); |
224 | is($st->pkid1, $_, "Oracle Auto-PK without trigger: First primary key"); |
225 | is($st->pkid2, $_ + 9, "Oracle Auto-PK without trigger: Second primary key"); |
226 | is($st->nonpkid, $_ + 19, "Oracle Auto-PK without trigger: Non-primary key"); |
227 | } |
228 | my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); |
229 | is($st->pkid1, 55, "Oracle Auto-PK without trigger: First primary key set manually"); |
ccd6f984 |
230 | |
12e05c15 |
231 | # test BLOBs |
8068691e |
232 | SKIP: { |
d7f20fdf |
233 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
234 | $binstr{'large'} = $binstr{'small'} x 1024; |
8068691e |
235 | |
d7f20fdf |
236 | my $maxloblen = length $binstr{'large'}; |
237 | note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; |
238 | local $dbh->{'LongReadLen'} = $maxloblen; |
5db2758d |
239 | |
d7f20fdf |
240 | my $rs = $schema->resultset('BindType'); |
241 | my $id = 0; |
5db2758d |
242 | |
931e5d43 |
243 | if ($DBD::Oracle::VERSION eq '1.23') { |
244 | throws_ok { $rs->create({ id => 1, blob => $binstr{large} }) } |
245 | qr/broken/, |
246 | 'throws on blob insert with DBD::Oracle == 1.23'; |
5db2758d |
247 | |
931e5d43 |
248 | skip 'buggy BLOB support in DBD::Oracle 1.23', 7; |
249 | } |
5db2758d |
250 | |
f3f6c13a |
251 | # disable BLOB mega-output |
252 | my $orig_debug = $schema->storage->debug; |
253 | $schema->storage->debug (0); |
254 | |
d7f20fdf |
255 | foreach my $type (qw( blob clob )) { |
256 | foreach my $size (qw( small large )) { |
257 | $id++; |
5db2758d |
258 | |
d7f20fdf |
259 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
260 | "inserted $size $type without dying"; |
261 | |
262 | ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); |
263 | } |
264 | } |
f3f6c13a |
265 | |
266 | $schema->storage->debug ($orig_debug); |
5db2758d |
267 | } |
268 | |
df6e3f5c |
269 | # test sequence detection from a different schema |
12e05c15 |
270 | my $schema2; |
9d7d2f00 |
271 | SKIP: { |
606b30c3 |
272 | TODO: { |
9d7d2f00 |
273 | skip ((join '', |
12e05c15 |
274 | 'Set DBICTEST_ORA_EXTRAUSER_DSN, _USER and _PASS to a *DIFFERENT* Oracle user', |
275 | ' to run the cross-schema autoincrement test.' |
276 | ), 1) unless $dsn2 && $user2 && $user2 ne $user; |
9d7d2f00 |
277 | |
606b30c3 |
278 | # Oracle8i Reference Release 2 (8.1.6) |
279 | # http://download.oracle.com/docs/cd/A87860_01/doc/server.817/a76961/ch294.htm#993 |
280 | # Oracle Database Reference 10g Release 2 (10.2) |
281 | # http://download.oracle.com/docs/cd/B19306_01/server.102/b14237/statviews_2107.htm#sthref1297 |
282 | local $TODO = "On Oracle8i all_triggers view is empty, i don't yet know why..." |
283 | if $schema->storage->_server_info->{normalized_dbms_version} < 9; |
284 | |
df6e3f5c |
285 | $schema2 = DBICTest::Schema->connect($dsn2, $user2, $pass2); |
286 | |
9d7d2f00 |
287 | my $schema1_dbh = $schema->storage->dbh; |
df6e3f5c |
288 | |
9d7d2f00 |
289 | $schema1_dbh->do("GRANT INSERT ON artist TO $user2"); |
f121db2e |
290 | $schema1_dbh->do("GRANT SELECT ON artist_pk_seq TO $user2"); |
df6e3f5c |
291 | |
72044892 |
292 | my $rs = $schema2->resultset('ArtistFQN'); |
df6e3f5c |
293 | |
72044892 |
294 | # first test with unquoted (default) sequence name in trigger body |
df6e3f5c |
295 | |
296 | lives_and { |
9d7d2f00 |
297 | my $row = $rs->create({ name => 'From Different Schema' }); |
df6e3f5c |
298 | ok $row->artistid; |
9d7d2f00 |
299 | } 'used autoinc sequence across schemas'; |
72044892 |
300 | |
301 | # now quote the sequence name |
72044892 |
302 | $schema1_dbh->do(qq{ |
f121db2e |
303 | CREATE OR REPLACE TRIGGER artist_insert_trg_pk |
72044892 |
304 | BEFORE INSERT ON artist |
305 | FOR EACH ROW |
306 | BEGIN |
307 | IF :new.artistid IS NULL THEN |
f121db2e |
308 | SELECT "ARTIST_PK_SEQ".nextval |
72044892 |
309 | INTO :new.artistid |
310 | FROM DUAL; |
311 | END IF; |
312 | END; |
313 | }); |
314 | |
315 | # sequence is cached in the rsrc |
316 | delete $rs->result_source->column_info('artistid')->{sequence}; |
317 | |
318 | lives_and { |
319 | my $row = $rs->create({ name => 'From Different Schema With Quoted Sequence' }); |
320 | ok $row->artistid; |
321 | } 'used quoted autoinc sequence across schemas'; |
322 | |
323 | my $schema_name = uc $user; |
324 | |
325 | is $rs->result_source->column_info('artistid')->{sequence}, |
f121db2e |
326 | qq[${schema_name}."ARTIST_PK_SEQ"], |
72044892 |
327 | 'quoted sequence name correctly extracted'; |
606b30c3 |
328 | } } |
df6e3f5c |
329 | |
86cc4156 |
330 | done_testing; |
331 | |
df6e3f5c |
332 | sub do_creates { |
333 | my $dbh = shift; |
334 | |
335 | eval { |
ab4f4e4c |
336 | $dbh->do("DROP SEQUENCE artist_autoinc_seq"); |
337 | $dbh->do("DROP SEQUENCE artist_pk_seq"); |
df6e3f5c |
338 | $dbh->do("DROP SEQUENCE cd_seq"); |
339 | $dbh->do("DROP SEQUENCE track_seq"); |
340 | $dbh->do("DROP SEQUENCE pkid1_seq"); |
341 | $dbh->do("DROP SEQUENCE pkid2_seq"); |
342 | $dbh->do("DROP SEQUENCE nonpkid_seq"); |
343 | $dbh->do("DROP TABLE artist"); |
344 | $dbh->do("DROP TABLE sequence_test"); |
345 | $dbh->do("DROP TABLE track"); |
346 | $dbh->do("DROP TABLE cd"); |
347 | }; |
ab4f4e4c |
348 | $dbh->do("CREATE SEQUENCE artist_autoinc_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
349 | $dbh->do("CREATE SEQUENCE artist_pk_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
df6e3f5c |
350 | $dbh->do("CREATE SEQUENCE cd_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
351 | $dbh->do("CREATE SEQUENCE track_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
352 | $dbh->do("CREATE SEQUENCE pkid1_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
353 | $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0"); |
354 | $dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0"); |
355 | |
12e05c15 |
356 | $dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), autoinc_col NUMBER(12), rank NUMBER(38), charfield VARCHAR2(10))"); |
df6e3f5c |
357 | $dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))"); |
358 | |
359 | $dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))"); |
360 | $dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))"); |
361 | |
362 | $dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))"); |
363 | $dbh->do("ALTER TABLE cd ADD (CONSTRAINT cd_pk PRIMARY KEY (cdid))"); |
364 | |
365 | $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)"); |
366 | $dbh->do("ALTER TABLE track ADD (CONSTRAINT track_pk PRIMARY KEY (trackid))"); |
367 | |
12e05c15 |
368 | $dbh->do("CREATE TABLE bindtype_test (id integer NOT NULL PRIMARY KEY, bytea integer NULL, blob blob NULL, clob clob NULL)"); |
369 | |
df6e3f5c |
370 | $dbh->do(qq{ |
ab4f4e4c |
371 | CREATE OR REPLACE TRIGGER artist_insert_trg_auto |
372 | BEFORE INSERT ON artist |
373 | FOR EACH ROW |
374 | BEGIN |
375 | IF :new.autoinc_col IS NULL THEN |
376 | SELECT artist_autoinc_seq.nextval |
377 | INTO :new.autoinc_col |
378 | FROM DUAL; |
379 | END IF; |
380 | END; |
381 | }); |
382 | $dbh->do(qq{ |
383 | CREATE OR REPLACE TRIGGER artist_insert_trg_pk |
df6e3f5c |
384 | BEFORE INSERT ON artist |
385 | FOR EACH ROW |
386 | BEGIN |
387 | IF :new.artistid IS NULL THEN |
ab4f4e4c |
388 | SELECT artist_pk_seq.nextval |
df6e3f5c |
389 | INTO :new.artistid |
390 | FROM DUAL; |
391 | END IF; |
392 | END; |
393 | }); |
394 | $dbh->do(qq{ |
395 | CREATE OR REPLACE TRIGGER cd_insert_trg |
396 | BEFORE INSERT OR UPDATE ON cd |
397 | FOR EACH ROW |
6f5f880d |
398 | DECLARE |
399 | tmpVar NUMBER; |
400 | |
df6e3f5c |
401 | BEGIN |
6f5f880d |
402 | tmpVar := 0; |
403 | |
df6e3f5c |
404 | IF :new.cdid IS NULL THEN |
405 | SELECT cd_seq.nextval |
6f5f880d |
406 | INTO tmpVar |
407 | FROM dual; |
408 | |
409 | :new.cdid := tmpVar; |
df6e3f5c |
410 | END IF; |
411 | END; |
412 | }); |
413 | $dbh->do(qq{ |
414 | CREATE OR REPLACE TRIGGER track_insert_trg |
415 | BEFORE INSERT ON track |
416 | FOR EACH ROW |
417 | BEGIN |
418 | IF :new.trackid IS NULL THEN |
419 | SELECT track_seq.nextval |
420 | INTO :new.trackid |
421 | FROM DUAL; |
422 | END IF; |
423 | END; |
424 | }); |
425 | } |
426 | |
0567538f |
427 | # clean up our mess |
3ff5b740 |
428 | END { |
df6e3f5c |
429 | for my $dbh (map $_->storage->dbh, grep $_, ($schema, $schema2)) { |
430 | eval { |
ab4f4e4c |
431 | $dbh->do("DROP SEQUENCE artist_autoinc_seq"); |
432 | $dbh->do("DROP SEQUENCE artist_pk_seq"); |
df6e3f5c |
433 | $dbh->do("DROP SEQUENCE cd_seq"); |
434 | $dbh->do("DROP SEQUENCE track_seq"); |
435 | $dbh->do("DROP SEQUENCE pkid1_seq"); |
436 | $dbh->do("DROP SEQUENCE pkid2_seq"); |
437 | $dbh->do("DROP SEQUENCE nonpkid_seq"); |
438 | $dbh->do("DROP TABLE artist"); |
439 | $dbh->do("DROP TABLE sequence_test"); |
440 | $dbh->do("DROP TABLE track"); |
441 | $dbh->do("DROP TABLE cd"); |
442 | $dbh->do("DROP TABLE bindtype_test"); |
443 | }; |
df6e3f5c |
444 | } |
3ff5b740 |
445 | } |