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