fixed sql mistakes from hierarchical query tests
[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
a499b173 104 eval {
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 });
117 };
5c6ed0b5 118
119 like $@, qr/rolling back outer txn/,
120 'correct exception for rollback';
121
a499b173 122 ok ((not $ars->search({ name => 'in_outer_txn' })->first),
123 'outer txn rolled back');
32323fc2 124
3a8aae80 125# test explicit key spec
126 $new = $ars->create ({ name => 'bar', artistid => 66 });
127 is($new->artistid, 66, 'Explicit PK worked');
128 $new->discard_changes;
129 is($new->artistid, 66, 'Explicit PK assigned');
130
e1958268 131# row update
babd3d8e 132 lives_ok {
133 $new->update({ name => 'baz' })
134 } 'update survived';
135 $new->discard_changes;
136 is $new->name, 'baz', 'row updated';
137
3a8aae80 138# test populate
139 lives_ok (sub {
140 my @pop;
141 for (1..2) {
142 push @pop, { name => "Artist_$_" };
143 }
144 $ars->populate (\@pop);
145 });
146
147# test populate with explicit key
148 lives_ok (sub {
149 my @pop;
150 for (1..2) {
151 push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ };
152 }
17d59d97 153 $ars->populate (\@pop);
3a8aae80 154 });
155
156# count what we did so far
157 is ($ars->count, 6, 'Simple count works');
158
e1958268 159# test ResultSet UPDATE
17d59d97 160 lives_and {
161 $ars->search({ name => 'foo' })->update({ rank => 4 });
162
dd2109ee 163 is eval { $ars->search({ name => 'foo' })->first->rank }, 4;
72537d31 164 } 'Can update a column';
165
166 my ($updated) = $schema->resultset('Artist')->search({name => 'foo'});
dd2109ee 167 is eval { $updated->rank }, 4, 'and the update made it to the database';
72537d31 168
169
3a8aae80 170# test LIMIT support
171 my $lim = $ars->search( {},
172 {
173 rows => 3,
174 offset => 4,
175 order_by => 'artistid'
176 }
177 );
178 is( $lim->count, 2, 'ROWS+OFFSET count ok' );
179 is( $lim->all, 2, 'Number of ->all objects matches count' );
180
181# test iterator
182 $lim->reset;
dd2109ee 183 is( eval { $lim->next->artistid }, 101, "iterator->next ok" );
184 is( eval { $lim->next->artistid }, 102, "iterator->next ok" );
3a8aae80 185 is( $lim->next, undef, "next past end of resultset ok" );
186
17d59d97 187# test multiple executing cursors
188 {
189 my $rs1 = $ars->search({}, { order_by => { -asc => 'artistid' }});
190 my $rs2 = $ars->search({}, { order_by => { -desc => 'artistid' }});
191
c13488fd 192 is $rs1->next->artistid, 1, 'multiple cursors';
193 is $rs2->next->artistid, 102, 'multiple 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
e1958268 244 ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" );
3a8aae80 245 }
246 }
247}
248
249done_testing;
250
251# clean up our mess
dff4c3a3 252
253sub cleanup {
145b2a3d 254 my $dbh;
255 eval {
256 $schema->storage->disconnect; # to avoid object FOO is in use errors
257 $dbh = $schema->storage->dbh;
258 };
259 return unless $dbh;
260
930689e6 261 eval { $dbh->do('DROP TRIGGER "artist_bi"') };
145b2a3d 262 diag $@ if $@;
263
e1958268 264 foreach my $generator (qw/gen_artist_artistid pkid1_seq pkid2_seq
265 nonpkid_seq/) {
266 eval { $dbh->do(qq{DROP GENERATOR "$generator"}) };
267 diag $@ if $@;
268 }
145b2a3d 269
ba19fccc 270 foreach my $table (qw/artist bindtype_test sequence_test/) {
9633951d 271 eval { $dbh->do(qq[DROP TABLE "$table"]) };
e1958268 272 diag $@ if $@;
3a8aae80 273 }
274}