Fix and test first_skip/skip_first limit dialects
[dbsrgits/DBIx-Class.git] / t / 750firebird.t
CommitLineData
3a8aae80 1use strict;
2use warnings;
3
4use Test::More;
5use Test::Exception;
199fbc45 6use DBIx::Class::Optional::Dependencies ();
3a8aae80 7use lib qw(t/lib);
8use DBICTest;
dff4c3a3 9use Scope::Guard ();
3a8aae80 10
49b3a264 11my $env2optdep = {
12 DBICTEST_FIREBIRD => 'test_rdbms_firebird',
13 DBICTEST_FIREBIRD_INTERBASE => 'test_rdbms_firebird_interbase',
14 DBICTEST_FIREBIRD_ODBC => 'test_rdbms_firebird_odbc',
15};
16
17plan skip_all => join (' ',
18 'Set $ENV{DBICTEST_FIREBIRD_DSN} and/or $ENV{DBICTEST_FIREBIRD_INTERBASE_DSN}',
19 'and/or $ENV{DBICTEST_FIREBIRD_ODBC_DSN},',
20 '_USER and _PASS to run these tests.',
21
22 'WARNING: this test creates and drops the tables "artist", "bindtype_test" and',
23 '"sequence_test"; the generators "gen_artist_artistid", "pkid1_seq", "pkid2_seq"',
24 'and "nonpkid_seq" and the trigger "artist_bi".',
25) unless grep { $ENV{"${_}_DSN"} } keys %$env2optdep;
3a8aae80 26
199fbc45 27# tests stolen from 749sybase_asa.t
3a8aae80 28
f7e5fd18 29# Example DSNs:
f7e5fd18 30# dbi:Firebird:db=/var/lib/firebird/2.5/data/hlaghdb.fdb
199fbc45 31# dbi:InterBase:db=/var/lib/firebird/2.5/data/hlaghdb.fdb
f7e5fd18 32
33# Example ODBC DSN:
34# dbi:ODBC:Driver=Firebird;Dbname=/var/lib/firebird/2.5/data/hlaghdb.fdb
35
145b2a3d 36my $schema;
3a8aae80 37
49b3a264 38for my $prefix (keys %$env2optdep) { SKIP: {
39
40 my ($dsn, $user, $pass) = map { $ENV{"${prefix}_$_"} } qw/DSN USER PASS/;
3a8aae80 41
42 next unless $dsn;
43
49b3a264 44 skip ("Testing with ${prefix}_DSN needs " . DBIx::Class::Optional::Dependencies->req_missing_for( $env2optdep->{$prefix} ), 1)
45 unless DBIx::Class::Optional::Dependencies->req_ok_for($env2optdep->{$prefix});
46
32323fc2 47 $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
dd2109ee 48 auto_savepoint => 1,
49 quote_char => q["],
50 name_sep => q[.],
e46df41a 51 ($dsn !~ /ODBC/ ? (on_connect_call => 'use_softcommit') : ()),
32323fc2 52 });
3a8aae80 53 my $dbh = $schema->storage->dbh;
54
dff4c3a3 55 my $sg = Scope::Guard->new(\&cleanup);
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
b9889595 209# test nested cursors
17d59d97 210 {
211 my $rs1 = $ars->search({}, { order_by => { -asc => 'artistid' }});
17d59d97 212
b9889595 213 my $rs2 = $ars->search({ artistid => $rs1->next->artistid }, {
214 order_by => { -desc => 'artistid' }
215 });
216
217 is $rs2->next->artistid, 1, 'nested cursors';
17d59d97 218 }
219
3a8aae80 220# test empty insert
28d28903 221 lives_and {
222 my $row = $ars->create({});
223 ok $row->artistid;
224 } 'empty insert works';
225
226# test inferring the generator from the trigger source and using it with
227# auto_nextval
3a8aae80 228 {
28d28903 229 local $ars->result_source->column_info('artistid')->{auto_nextval} = 1;
3a8aae80 230
28d28903 231 lives_and {
232 my $row = $ars->create({ name => 'introspecting generator' });
233 ok $row->artistid;
234 } 'inferring generator from trigger source works';
3a8aae80 235 }
236
237# test blobs (stolen from 73oracle.t)
ba19fccc 238 eval { $dbh->do('DROP TABLE "bindtype_test"') };
e1958268 239 $dbh->do(q[
ba19fccc 240 CREATE TABLE "bindtype_test"
e1958268 241 (
242 "id" INT PRIMARY KEY,
243 "bytea" INT,
ba19fccc 244 "blob" BLOB,
f3a9ea3d 245 "clob" BLOB SUB_TYPE TEXT,
246 "a_memo" INT
e1958268 247 )
248 ]);
249
250 my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
251 $binstr{'large'} = $binstr{'small'} x 1024;
252
253 my $maxloblen = length $binstr{'large'};
254 local $dbh->{'LongReadLen'} = $maxloblen;
255
ba19fccc 256 my $rs = $schema->resultset('BindType');
e1958268 257 my $id = 0;
258
ba19fccc 259 foreach my $type (qw( blob clob )) {
e1958268 260 foreach my $size (qw( small large )) {
261 $id++;
3a8aae80 262
263# turn off horrendous binary DBIC_TRACE output
e1958268 264 local $schema->storage->{debug} = 0;
3a8aae80 265
e1958268 266 lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }
267 "inserted $size $type without dying";
3a8aae80 268
cdf7f026 269 my $got = $rs->find($id)->$type;
270
271 my $hexdump = sub { join '', map sprintf('%02X', ord), split //, shift };
272
273 ok($got eq $binstr{$size}, "verified inserted $size $type" )
274 or do {
275 diag "For " . (ref $schema->storage) . "\n";
276 diag "Got blob:\n";
277 diag $hexdump->(substr($got,0,50));
278 diag "Expecting blob:\n";
279 diag $hexdump->(substr($binstr{$size},0,50));
280 };
3a8aae80 281 }
282 }
49b3a264 283}}
3a8aae80 284
285done_testing;
286
287# clean up our mess
dff4c3a3 288
289sub cleanup {
145b2a3d 290 my $dbh;
291 eval {
292 $schema->storage->disconnect; # to avoid object FOO is in use errors
293 $dbh = $schema->storage->dbh;
294 };
295 return unless $dbh;
296
930689e6 297 eval { $dbh->do('DROP TRIGGER "artist_bi"') };
145b2a3d 298 diag $@ if $@;
299
07cda1c5 300 foreach my $generator (qw/
301 "gen_artist_artistid"
302 "pkid1_seq"
303 pkid2_seq
304 "nonpkid_seq"
305 /) {
306 eval { $dbh->do(qq{DROP GENERATOR $generator}) };
e1958268 307 diag $@ if $@;
308 }
145b2a3d 309
ba19fccc 310 foreach my $table (qw/artist bindtype_test sequence_test/) {
9633951d 311 eval { $dbh->do(qq[DROP TABLE "$table"]) };
e1958268 312 diag $@ if $@;
3a8aae80 313 }
314}