Fix multiple storage regressions from 52416317
[dbsrgits/DBIx-Class.git] / t / 750firebird.t
CommitLineData
3a8aae80 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
6use lib qw(t/lib);
7use DBICTest;
dff4c3a3 8use Scope::Guard ();
3a8aae80 9
10# tests stolen from 749sybase_asa.t
11
12my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_FIREBIRD_${_}" } qw/DSN USER PASS/};
13my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_FIREBIRD_ODBC_${_}" } qw/DSN USER PASS/};
14
15plan skip_all => <<'EOF' unless $dsn || $dsn2;
16Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN},
28d28903 17_USER and _PASS to run these tests.
18
19WARNING: this test creates and drops the tables "artist", "bindtype_test" and
20"sequence_test"; the generators "gen_artist_artistid", "pkid1_seq", "pkid2_seq"
21and "nonpkid_seq" and the trigger "artist_bi".
3a8aae80 22EOF
23
24my @info = (
25 [ $dsn, $user, $pass ],
26 [ $dsn2, $user2, $pass2 ],
27);
28
145b2a3d 29my $schema;
3a8aae80 30
5c6ed0b5 31foreach 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 )
54EOF
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
66EOF
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 )
75EOF
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
260done_testing;
261
262# clean up our mess
dff4c3a3 263
264sub 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}