Commit | Line | Data |
3a8aae80 |
1 | use strict; |
2 | use warnings; |
3 | |
4 | use Test::More; |
5 | use Test::Exception; |
6 | use lib qw(t/lib); |
7 | use DBICTest; |
dff4c3a3 |
8 | use Scope::Guard (); |
3a8aae80 |
9 | |
10 | # tests stolen from 749sybase_asa.t |
11 | |
12 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/}; |
13 | my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/}; |
14 | |
15 | plan skip_all => <<'EOF' unless $dsn || $dsn2; |
16 | Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN}, |
28d28903 |
17 | _USER and _PASS to run these tests. |
18 | |
19 | WARNING: this test creates and drops the tables "artist", "bindtype_test" and |
20 | "sequence_test"; the generators "gen_artist_artistid", "pkid1_seq", "pkid2_seq" |
21 | and "nonpkid_seq" and the trigger "artist_bi". |
3a8aae80 |
22 | EOF |
23 | |
24 | my @info = ( |
25 | [ $dsn, $user, $pass ], |
26 | [ $dsn2, $user2, $pass2 ], |
27 | ); |
28 | |
145b2a3d |
29 | my $schema; |
3a8aae80 |
30 | |
5c6ed0b5 |
31 | foreach my $conn_idx (0..$#info) { |
9633951d |
32 | my ($dsn, $user, $pass) = @{ $info[$conn_idx] || [] }; |
3a8aae80 |
33 | |
34 | next unless $dsn; |
35 | |
32323fc2 |
36 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
dd2109ee |
37 | auto_savepoint => 1, |
38 | quote_char => q["], |
39 | name_sep => q[.], |
40 | on_connect_call => 'use_softcommit', |
32323fc2 |
41 | }); |
3a8aae80 |
42 | my $dbh = $schema->storage->dbh; |
43 | |
dff4c3a3 |
44 | my $sg = Scope::Guard->new(\&cleanup); |
3a8aae80 |
45 | |
930689e6 |
46 | eval { $dbh->do(q[DROP TABLE "artist"]) }; |
3a8aae80 |
47 | $dbh->do(<<EOF); |
930689e6 |
48 | CREATE TABLE "artist" ( |
49 | "artistid" INT PRIMARY KEY, |
50 | "name" VARCHAR(255), |
51 | "charfield" CHAR(10), |
52 | "rank" INT DEFAULT 13 |
3a8aae80 |
53 | ) |
54 | EOF |
930689e6 |
55 | eval { $dbh->do(q[DROP GENERATOR "gen_artist_artistid"]) }; |
56 | $dbh->do('CREATE GENERATOR "gen_artist_artistid"'); |
57 | eval { $dbh->do('DROP TRIGGER "artist_bi"') }; |
3a8aae80 |
58 | $dbh->do(<<EOF); |
930689e6 |
59 | CREATE TRIGGER "artist_bi" FOR "artist" |
3a8aae80 |
60 | ACTIVE BEFORE INSERT POSITION 0 |
61 | AS |
62 | BEGIN |
930689e6 |
63 | IF (NEW."artistid" IS NULL) THEN |
64 | NEW."artistid" = GEN_ID("gen_artist_artistid",1); |
3a8aae80 |
65 | END |
66 | EOF |
e1958268 |
67 | eval { $dbh->do('DROP TABLE "sequence_test"') }; |
68 | $dbh->do(<<EOF); |
69 | CREATE TABLE "sequence_test" ( |
70 | "pkid1" INT NOT NULL, |
71 | "pkid2" INT NOT NULL, |
72 | "nonpkid" INT, |
73 | "name" VARCHAR(255) |
74 | ) |
75 | EOF |
76 | $dbh->do('ALTER TABLE "sequence_test" ADD CONSTRAINT "sequence_test_constraint" PRIMARY KEY ("pkid1", "pkid2")'); |
77 | eval { $dbh->do('DROP GENERATOR "pkid1_seq"') }; |
78 | eval { $dbh->do('DROP GENERATOR "pkid2_seq"') }; |
79 | eval { $dbh->do('DROP GENERATOR "nonpkid_seq"') }; |
80 | $dbh->do('CREATE GENERATOR "pkid1_seq"'); |
81 | $dbh->do('CREATE GENERATOR "pkid2_seq"'); |
82 | $dbh->do('SET GENERATOR "pkid2_seq" TO 9'); |
83 | $dbh->do('CREATE GENERATOR "nonpkid_seq"'); |
84 | $dbh->do('SET GENERATOR "nonpkid_seq" TO 19'); |
3a8aae80 |
85 | |
86 | my $ars = $schema->resultset('Artist'); |
87 | is ( $ars->count, 0, 'No rows at first' ); |
88 | |
89 | # test primary key handling |
90 | my $new = $ars->create({ name => 'foo' }); |
91 | ok($new->artistid, "Auto-PK worked"); |
92 | |
e1958268 |
93 | # test auto increment using generators WITHOUT triggers |
94 | for (1..5) { |
95 | my $st = $schema->resultset('SequenceTest')->create({ name => 'foo' }); |
96 | is($st->pkid1, $_, "Firebird Auto-PK without trigger: First primary key"); |
97 | is($st->pkid2, $_ + 9, "Firebird Auto-PK without trigger: Second primary key"); |
98 | is($st->nonpkid, $_ + 19, "Firebird Auto-PK without trigger: Non-primary key"); |
99 | } |
100 | my $st = $schema->resultset('SequenceTest')->create({ name => 'foo', pkid1 => 55 }); |
101 | is($st->pkid1, 55, "Firebird Auto-PK without trigger: First primary key set manually"); |
102 | |
32323fc2 |
103 | # test savepoints |
b9889595 |
104 | throws_ok { |
a499b173 |
105 | $schema->txn_do(sub { |
106 | eval { |
107 | $schema->txn_do(sub { |
108 | $ars->create({ name => 'in_savepoint' }); |
109 | die "rolling back savepoint"; |
110 | }); |
111 | }; |
112 | ok ((not $ars->search({ name => 'in_savepoint' })->first), |
113 | 'savepoint rolled back'); |
114 | $ars->create({ name => 'in_outer_txn' }); |
115 | die "rolling back outer txn"; |
116 | }); |
b9889595 |
117 | } qr/rolling back outer txn/, |
5c6ed0b5 |
118 | 'correct exception for rollback'; |
119 | |
a499b173 |
120 | ok ((not $ars->search({ name => 'in_outer_txn' })->first), |
121 | 'outer txn rolled back'); |
32323fc2 |
122 | |
3a8aae80 |
123 | # test explicit key spec |
124 | $new = $ars->create ({ name => 'bar', artistid => 66 }); |
125 | is($new->artistid, 66, 'Explicit PK worked'); |
126 | $new->discard_changes; |
127 | is($new->artistid, 66, 'Explicit PK assigned'); |
128 | |
e1958268 |
129 | # row update |
babd3d8e |
130 | lives_ok { |
131 | $new->update({ name => 'baz' }) |
132 | } 'update survived'; |
133 | $new->discard_changes; |
134 | is $new->name, 'baz', 'row updated'; |
135 | |
3a8aae80 |
136 | # test populate |
137 | lives_ok (sub { |
138 | my @pop; |
139 | for (1..2) { |
140 | push @pop, { name => "Artist_$_" }; |
141 | } |
142 | $ars->populate (\@pop); |
143 | }); |
144 | |
145 | # test populate with explicit key |
146 | lives_ok (sub { |
147 | my @pop; |
148 | for (1..2) { |
149 | push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; |
150 | } |
17d59d97 |
151 | $ars->populate (\@pop); |
3a8aae80 |
152 | }); |
153 | |
154 | # count what we did so far |
155 | is ($ars->count, 6, 'Simple count works'); |
156 | |
e1958268 |
157 | # test ResultSet UPDATE |
17d59d97 |
158 | lives_and { |
159 | $ars->search({ name => 'foo' })->update({ rank => 4 }); |
160 | |
dd2109ee |
161 | is eval { $ars->search({ name => 'foo' })->first->rank }, 4; |
72537d31 |
162 | } 'Can update a column'; |
163 | |
164 | my ($updated) = $schema->resultset('Artist')->search({name => 'foo'}); |
dd2109ee |
165 | is eval { $updated->rank }, 4, 'and the update made it to the database'; |
72537d31 |
166 | |
167 | |
3a8aae80 |
168 | # test LIMIT support |
169 | my $lim = $ars->search( {}, |
170 | { |
171 | rows => 3, |
172 | offset => 4, |
173 | order_by => 'artistid' |
174 | } |
175 | ); |
176 | is( $lim->count, 2, 'ROWS+OFFSET count ok' ); |
177 | is( $lim->all, 2, 'Number of ->all objects matches count' ); |
178 | |
179 | # test iterator |
180 | $lim->reset; |
dd2109ee |
181 | is( eval { $lim->next->artistid }, 101, "iterator->next ok" ); |
182 | is( eval { $lim->next->artistid }, 102, "iterator->next ok" ); |
3a8aae80 |
183 | is( $lim->next, undef, "next past end of resultset ok" ); |
184 | |
b9889595 |
185 | # test nested cursors |
17d59d97 |
186 | { |
187 | my $rs1 = $ars->search({}, { order_by => { -asc => 'artistid' }}); |
17d59d97 |
188 | |
b9889595 |
189 | my $rs2 = $ars->search({ artistid => $rs1->next->artistid }, { |
190 | order_by => { -desc => 'artistid' } |
191 | }); |
192 | |
193 | is $rs2->next->artistid, 1, 'nested cursors'; |
17d59d97 |
194 | } |
195 | |
3a8aae80 |
196 | # test empty insert |
28d28903 |
197 | lives_and { |
198 | my $row = $ars->create({}); |
199 | ok $row->artistid; |
200 | } 'empty insert works'; |
201 | |
202 | # test inferring the generator from the trigger source and using it with |
203 | # auto_nextval |
3a8aae80 |
204 | { |
28d28903 |
205 | local $ars->result_source->column_info('artistid')->{auto_nextval} = 1; |
3a8aae80 |
206 | |
28d28903 |
207 | lives_and { |
208 | my $row = $ars->create({ name => 'introspecting generator' }); |
209 | ok $row->artistid; |
210 | } 'inferring generator from trigger source works'; |
3a8aae80 |
211 | } |
212 | |
213 | # test blobs (stolen from 73oracle.t) |
ba19fccc |
214 | eval { $dbh->do('DROP TABLE "bindtype_test"') }; |
e1958268 |
215 | $dbh->do(q[ |
ba19fccc |
216 | CREATE TABLE "bindtype_test" |
e1958268 |
217 | ( |
218 | "id" INT PRIMARY KEY, |
219 | "bytea" INT, |
ba19fccc |
220 | "blob" BLOB, |
221 | "clob" BLOB SUB_TYPE TEXT |
e1958268 |
222 | ) |
223 | ]); |
224 | |
225 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
226 | $binstr{'large'} = $binstr{'small'} x 1024; |
227 | |
228 | my $maxloblen = length $binstr{'large'}; |
229 | local $dbh->{'LongReadLen'} = $maxloblen; |
230 | |
ba19fccc |
231 | my $rs = $schema->resultset('BindType'); |
e1958268 |
232 | my $id = 0; |
233 | |
ba19fccc |
234 | foreach my $type (qw( blob clob )) { |
e1958268 |
235 | foreach my $size (qw( small large )) { |
236 | $id++; |
3a8aae80 |
237 | |
238 | # turn off horrendous binary DBIC_TRACE output |
e1958268 |
239 | local $schema->storage->{debug} = 0; |
3a8aae80 |
240 | |
e1958268 |
241 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
242 | "inserted $size $type without dying"; |
3a8aae80 |
243 | |
cdf7f026 |
244 | my $got = $rs->find($id)->$type; |
245 | |
246 | my $hexdump = sub { join '', map sprintf('%02X', ord), split //, shift }; |
247 | |
248 | ok($got eq $binstr{$size}, "verified inserted $size $type" ) |
249 | or do { |
250 | diag "For " . (ref $schema->storage) . "\n"; |
251 | diag "Got blob:\n"; |
252 | diag $hexdump->(substr($got,0,50)); |
253 | diag "Expecting blob:\n"; |
254 | diag $hexdump->(substr($binstr{$size},0,50)); |
255 | }; |
3a8aae80 |
256 | } |
257 | } |
258 | } |
259 | |
260 | done_testing; |
261 | |
262 | # clean up our mess |
dff4c3a3 |
263 | |
264 | sub cleanup { |
145b2a3d |
265 | my $dbh; |
266 | eval { |
267 | $schema->storage->disconnect; # to avoid object FOO is in use errors |
268 | $dbh = $schema->storage->dbh; |
269 | }; |
270 | return unless $dbh; |
271 | |
930689e6 |
272 | eval { $dbh->do('DROP TRIGGER "artist_bi"') }; |
145b2a3d |
273 | diag $@ if $@; |
274 | |
e1958268 |
275 | foreach my $generator (qw/gen_artist_artistid pkid1_seq pkid2_seq |
276 | nonpkid_seq/) { |
277 | eval { $dbh->do(qq{DROP GENERATOR "$generator"}) }; |
278 | diag $@ if $@; |
279 | } |
145b2a3d |
280 | |
ba19fccc |
281 | foreach my $table (qw/artist bindtype_test sequence_test/) { |
9633951d |
282 | eval { $dbh->do(qq[DROP TABLE "$table"]) }; |
e1958268 |
283 | diag $@ if $@; |
3a8aae80 |
284 | } |
285 | } |