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 | }, |
22 | ); |
23 | __PACKAGE__->set_primary_key('artistid'); |
24 | |
25 | 1; |
26 | } |
27 | |
70350518 |
28 | use strict; |
e6dd7b42 |
29 | use warnings; |
70350518 |
30 | |
5db2758d |
31 | use Test::Exception; |
70350518 |
32 | use Test::More; |
33 | use lib qw(t/lib); |
34 | use DBICTest; |
0567538f |
35 | |
36 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; |
37 | |
70350518 |
38 | plan skip_all => 'Set $ENV{DBICTEST_ORA_DSN}, _USER and _PASS to run this test. ' . |
39b8d119 |
39 | 'Warning: This test drops and creates tables called \'artist\', \'cd\', \'track\' and \'sequence_test\''. |
40 | ' as well as following sequences: \'pkid1_seq\', \'pkid2_seq\' and \'nonpkid_seq\'' |
0567538f |
41 | unless ($dsn && $user && $pass); |
42 | |
cb464582 |
43 | DBICTest::Schema->load_classes('ArtistFQN'); |
9900b569 |
44 | my $schema = DBICTest::Schema->connect($dsn, $user, $pass); |
0567538f |
45 | |
3ff5b740 |
46 | my $dbh = $schema->storage->dbh; |
0567538f |
47 | |
48 | eval { |
49 | $dbh->do("DROP SEQUENCE artist_seq"); |
e6dd7b42 |
50 | $dbh->do("DROP SEQUENCE cd_seq"); |
39b8d119 |
51 | $dbh->do("DROP SEQUENCE pkid1_seq"); |
52 | $dbh->do("DROP SEQUENCE pkid2_seq"); |
53 | $dbh->do("DROP SEQUENCE nonpkid_seq"); |
0567538f |
54 | $dbh->do("DROP TABLE artist"); |
39b8d119 |
55 | $dbh->do("DROP TABLE sequence_test"); |
2660b14e |
56 | $dbh->do("DROP TABLE cd"); |
57 | $dbh->do("DROP TABLE track"); |
0567538f |
58 | }; |
59 | $dbh->do("CREATE SEQUENCE artist_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
e6dd7b42 |
60 | $dbh->do("CREATE SEQUENCE cd_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
39b8d119 |
61 | $dbh->do("CREATE SEQUENCE pkid1_seq START WITH 1 MAXVALUE 999999 MINVALUE 0"); |
62 | $dbh->do("CREATE SEQUENCE pkid2_seq START WITH 10 MAXVALUE 999999 MINVALUE 0"); |
63 | $dbh->do("CREATE SEQUENCE nonpkid_seq START WITH 20 MAXVALUE 999999 MINVALUE 0"); |
7c4ead2d |
64 | $dbh->do("CREATE TABLE artist (artistid NUMBER(12), name VARCHAR(255), rank NUMBER(38), charfield VARCHAR2(10))"); |
39b8d119 |
65 | $dbh->do("CREATE TABLE sequence_test (pkid1 NUMBER(12), pkid2 NUMBER(12), nonpkid NUMBER(12), name VARCHAR(255))"); |
6c0230de |
66 | $dbh->do("CREATE TABLE cd (cdid NUMBER(12), artist NUMBER(12), title VARCHAR(255), year VARCHAR(4), genreid NUMBER(12), single_track NUMBER(12))"); |
2d124f01 |
67 | $dbh->do("CREATE TABLE track (trackid NUMBER(12), cd NUMBER(12), position NUMBER(12), title VARCHAR(255), last_updated_on DATE, last_updated_at DATE, small_dt DATE)"); |
2660b14e |
68 | |
0567538f |
69 | $dbh->do("ALTER TABLE artist ADD (CONSTRAINT artist_pk PRIMARY KEY (artistid))"); |
e6dd7b42 |
70 | $dbh->do("ALTER TABLE cd ADD (CONSTRAINT cd_pk PRIMARY KEY (cdid))"); |
39b8d119 |
71 | $dbh->do("ALTER TABLE sequence_test ADD (CONSTRAINT sequence_test_constraint PRIMARY KEY (pkid1, pkid2))"); |
0567538f |
72 | $dbh->do(qq{ |
73 | CREATE OR REPLACE TRIGGER artist_insert_trg |
74 | BEFORE INSERT ON artist |
75 | FOR EACH ROW |
76 | BEGIN |
77 | IF :new.artistid IS NULL THEN |
78 | SELECT artist_seq.nextval |
79 | INTO :new.artistid |
80 | FROM DUAL; |
81 | END IF; |
82 | END; |
83 | }); |
e6dd7b42 |
84 | $dbh->do(qq{ |
85 | CREATE OR REPLACE TRIGGER cd_insert_trg |
86 | BEFORE INSERT ON cd |
87 | FOR EACH ROW |
88 | BEGIN |
89 | IF :new.cdid IS NULL THEN |
90 | SELECT cd_seq.nextval |
91 | INTO :new.cdid |
92 | FROM DUAL; |
93 | END IF; |
94 | END; |
95 | }); |
0567538f |
96 | |
5db2758d |
97 | { |
98 | # Swiped from t/bindtype_columns.t to avoid creating my own Resultset. |
99 | |
100 | local $SIG{__WARN__} = sub {}; |
101 | eval { $dbh->do('DROP TABLE bindtype_test') }; |
102 | |
103 | $dbh->do(qq[ |
e6dd7b42 |
104 | CREATE TABLE bindtype_test |
5db2758d |
105 | ( |
106 | id integer NOT NULL PRIMARY KEY, |
107 | bytea integer NULL, |
108 | blob blob NULL, |
109 | clob clob NULL |
110 | ) |
111 | ],{ RaiseError => 1, PrintError => 1 }); |
112 | } |
113 | |
3ff5b740 |
114 | # This is in Core now, but it's here just to test that it doesn't break |
115 | $schema->class('Artist')->load_components('PK::Auto'); |
116 | # These are compat shims for PK::Auto... |
117 | $schema->class('CD')->load_components('PK::Auto::Oracle'); |
118 | $schema->class('Track')->load_components('PK::Auto::Oracle'); |
0567538f |
119 | |
120 | # test primary key handling |
3ff5b740 |
121 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
c8f4b52b |
122 | is($new->artistid, 1, "Oracle Auto-PK worked"); |
0567538f |
123 | |
e6dd7b42 |
124 | my $cd = $schema->resultset('CD')->create({ artist => 1, title => 'EP C', year => '2003' }); |
62d4dbae |
125 | is($cd->cdid, 1, "Oracle Auto-PK worked - using scalar ref as table name"); |
e6dd7b42 |
126 | |
cb464582 |
127 | # test again with fully-qualified table name |
128 | $new = $schema->resultset('ArtistFQN')->create( { name => 'bar' } ); |
129 | is( $new->artistid, 2, "Oracle Auto-PK worked with fully-qualified tablename" ); |
130 | |
62d4dbae |
131 | # test rel names over the 30 char limit |
132 | my $query = $schema->resultset('Artist')->search({ |
6c0230de |
133 | artistid => 1 |
62d4dbae |
134 | }, { |
135 | prefetch => 'cds_very_very_very_long_relationship_name' |
136 | }); |
137 | |
138 | lives_and { |
6c0230de |
139 | is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 |
62d4dbae |
140 | } 'query with rel name over 30 chars survived and worked'; |
141 | |
6c0230de |
142 | # rel name over 30 char limit with user condition |
143 | # This requires walking the SQLA data structure. |
144 | { |
145 | local $TODO = 'user condition on rel longer than 30 chars'; |
146 | |
147 | $query = $schema->resultset('Artist')->search({ |
148 | 'cds_very_very_very_long_relationship_name.title' => 'EP C' |
149 | }, { |
150 | prefetch => 'cds_very_very_very_long_relationship_name' |
151 | }); |
152 | |
153 | lives_and { |
154 | is $query->first->cds_very_very_very_long_relationship_name->first->cdid, 1 |
155 | } 'query with rel name over 30 chars and user condition survived and worked'; |
156 | } |
157 | |
9900b569 |
158 | # test join with row count ambiguity |
d2a3958e |
159 | |
d2a3958e |
160 | my $track = $schema->resultset('Track')->create({ trackid => 1, cd => 1, |
9900b569 |
161 | position => 1, title => 'Track1' }); |
3ff5b740 |
162 | my $tjoin = $schema->resultset('Track')->search({ 'me.title' => 'Track1'}, |
2660b14e |
163 | { join => 'cd', |
164 | rows => 2 } |
165 | ); |
166 | |
d2a3958e |
167 | ok(my $row = $tjoin->next); |
168 | |
169 | is($row->title, 'Track1', "ambiguous column ok"); |
2660b14e |
170 | |
286f32b3 |
171 | # check count distinct with multiple columns |
3ff5b740 |
172 | my $other_track = $schema->resultset('Track')->create({ trackid => 2, cd => 1, position => 1, title => 'Track2' }); |
11d68671 |
173 | |
3ff5b740 |
174 | my $tcount = $schema->resultset('Track')->search( |
11d68671 |
175 | {}, |
176 | { |
177 | select => [ qw/position title/ ], |
178 | distinct => 1, |
179 | } |
180 | ); |
f12f0d97 |
181 | is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); |
11d68671 |
182 | |
183 | $tcount = $schema->resultset('Track')->search( |
184 | {}, |
185 | { |
186 | columns => [ qw/position title/ ], |
187 | distinct => 1, |
188 | } |
189 | ); |
f12f0d97 |
190 | is($tcount->count, 2, 'multiple column COUNT DISTINCT ok'); |
286f32b3 |
191 | |
11d68671 |
192 | $tcount = $schema->resultset('Track')->search( |
193 | {}, |
e6dd7b42 |
194 | { |
11d68671 |
195 | group_by => [ qw/position title/ ] |
196 | } |
197 | ); |
f12f0d97 |
198 | is($tcount->count, 2, 'multiple column COUNT DISTINCT using column syntax ok'); |
2660b14e |
199 | |
0567538f |
200 | # test LIMIT support |
201 | for (1..6) { |
3ff5b740 |
202 | $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
0567538f |
203 | } |
3ff5b740 |
204 | my $it = $schema->resultset('Artist')->search( {}, |
0567538f |
205 | { rows => 3, |
cb464582 |
206 | offset => 3, |
0567538f |
207 | order_by => 'artistid' } |
208 | ); |
209 | is( $it->count, 3, "LIMIT count ok" ); |
210 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
211 | $it->next; |
212 | $it->next; |
213 | is( $it->next, undef, "next past end of resultset ok" ); |
214 | |
e8e971f2 |
215 | { |
216 | my $rs = $schema->resultset('Track')->search( undef, { columns=>[qw/trackid position/], group_by=> [ qw/trackid position/ ] , rows => 2, offset=>1 }); |
217 | my @results = $rs->all; |
218 | is( scalar @results, 1, "Group by with limit OK" ); |
219 | } |
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 | |
8068691e |
231 | SKIP: { |
d7f20fdf |
232 | skip 'buggy BLOB support in DBD::Oracle 1.23', 8 |
233 | if $DBD::Oracle::VERSION == 1.23; |
8068691e |
234 | |
d7f20fdf |
235 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
236 | $binstr{'large'} = $binstr{'small'} x 1024; |
5db2758d |
237 | |
d7f20fdf |
238 | my $maxloblen = length $binstr{'large'}; |
239 | note "Localizing LongReadLen to $maxloblen to avoid truncation of test data"; |
240 | local $dbh->{'LongReadLen'} = $maxloblen; |
5db2758d |
241 | |
d7f20fdf |
242 | my $rs = $schema->resultset('BindType'); |
243 | my $id = 0; |
5db2758d |
244 | |
d7f20fdf |
245 | foreach my $type (qw( blob clob )) { |
246 | foreach my $size (qw( small large )) { |
247 | $id++; |
5db2758d |
248 | |
d7f20fdf |
249 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
250 | "inserted $size $type without dying"; |
251 | |
252 | ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); |
253 | } |
254 | } |
5db2758d |
255 | } |
256 | |
86cc4156 |
257 | done_testing; |
258 | |
0567538f |
259 | # clean up our mess |
3ff5b740 |
260 | END { |
fe0d48d3 |
261 | if($schema && ($dbh = $schema->storage->dbh)) { |
3ff5b740 |
262 | $dbh->do("DROP SEQUENCE artist_seq"); |
e6dd7b42 |
263 | $dbh->do("DROP SEQUENCE cd_seq"); |
39b8d119 |
264 | $dbh->do("DROP SEQUENCE pkid1_seq"); |
265 | $dbh->do("DROP SEQUENCE pkid2_seq"); |
266 | $dbh->do("DROP SEQUENCE nonpkid_seq"); |
3ff5b740 |
267 | $dbh->do("DROP TABLE artist"); |
39b8d119 |
268 | $dbh->do("DROP TABLE sequence_test"); |
3ff5b740 |
269 | $dbh->do("DROP TABLE cd"); |
270 | $dbh->do("DROP TABLE track"); |
5db2758d |
271 | $dbh->do("DROP TABLE bindtype_test"); |
3ff5b740 |
272 | } |
273 | } |
0567538f |
274 | |