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}, |
17 | _USER and _PASS to run these tests |
18 | EOF |
19 | |
20 | my @info = ( |
21 | [ $dsn, $user, $pass ], |
22 | [ $dsn2, $user2, $pass2 ], |
23 | ); |
24 | |
145b2a3d |
25 | my $schema; |
3a8aae80 |
26 | |
5c6ed0b5 |
27 | foreach my $conn_idx (0..$#info) { |
9633951d |
28 | my ($dsn, $user, $pass) = @{ $info[$conn_idx] || [] }; |
3a8aae80 |
29 | |
30 | next unless $dsn; |
31 | |
32323fc2 |
32 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
dd2109ee |
33 | auto_savepoint => 1, |
34 | quote_char => q["], |
35 | name_sep => q[.], |
36 | on_connect_call => 'use_softcommit', |
32323fc2 |
37 | }); |
3a8aae80 |
38 | my $dbh = $schema->storage->dbh; |
39 | |
dff4c3a3 |
40 | my $sg = Scope::Guard->new(\&cleanup); |
3a8aae80 |
41 | |
930689e6 |
42 | eval { $dbh->do(q[DROP TABLE "artist"]) }; |
3a8aae80 |
43 | $dbh->do(<<EOF); |
930689e6 |
44 | CREATE TABLE "artist" ( |
45 | "artistid" INT PRIMARY KEY, |
46 | "name" VARCHAR(255), |
47 | "charfield" CHAR(10), |
48 | "rank" INT DEFAULT 13 |
3a8aae80 |
49 | ) |
50 | EOF |
930689e6 |
51 | eval { $dbh->do(q[DROP GENERATOR "gen_artist_artistid"]) }; |
52 | $dbh->do('CREATE GENERATOR "gen_artist_artistid"'); |
53 | eval { $dbh->do('DROP TRIGGER "artist_bi"') }; |
3a8aae80 |
54 | $dbh->do(<<EOF); |
930689e6 |
55 | CREATE TRIGGER "artist_bi" FOR "artist" |
3a8aae80 |
56 | ACTIVE BEFORE INSERT POSITION 0 |
57 | AS |
58 | BEGIN |
930689e6 |
59 | IF (NEW."artistid" IS NULL) THEN |
60 | NEW."artistid" = GEN_ID("gen_artist_artistid",1); |
3a8aae80 |
61 | END |
62 | EOF |
63 | |
64 | my $ars = $schema->resultset('Artist'); |
65 | is ( $ars->count, 0, 'No rows at first' ); |
66 | |
67 | # test primary key handling |
68 | my $new = $ars->create({ name => 'foo' }); |
69 | ok($new->artistid, "Auto-PK worked"); |
70 | |
32323fc2 |
71 | # test savepoints |
a499b173 |
72 | eval { |
73 | $schema->txn_do(sub { |
74 | eval { |
75 | $schema->txn_do(sub { |
76 | $ars->create({ name => 'in_savepoint' }); |
77 | die "rolling back savepoint"; |
78 | }); |
79 | }; |
80 | ok ((not $ars->search({ name => 'in_savepoint' })->first), |
81 | 'savepoint rolled back'); |
82 | $ars->create({ name => 'in_outer_txn' }); |
83 | die "rolling back outer txn"; |
84 | }); |
85 | }; |
5c6ed0b5 |
86 | |
87 | like $@, qr/rolling back outer txn/, |
88 | 'correct exception for rollback'; |
89 | |
a499b173 |
90 | ok ((not $ars->search({ name => 'in_outer_txn' })->first), |
91 | 'outer txn rolled back'); |
32323fc2 |
92 | |
3a8aae80 |
93 | # test explicit key spec |
94 | $new = $ars->create ({ name => 'bar', artistid => 66 }); |
95 | is($new->artistid, 66, 'Explicit PK worked'); |
96 | $new->discard_changes; |
97 | is($new->artistid, 66, 'Explicit PK assigned'); |
98 | |
babd3d8e |
99 | lives_ok { |
100 | $new->update({ name => 'baz' }) |
101 | } 'update survived'; |
102 | $new->discard_changes; |
103 | is $new->name, 'baz', 'row updated'; |
104 | |
3a8aae80 |
105 | # test populate |
106 | lives_ok (sub { |
107 | my @pop; |
108 | for (1..2) { |
109 | push @pop, { name => "Artist_$_" }; |
110 | } |
111 | $ars->populate (\@pop); |
112 | }); |
113 | |
114 | # test populate with explicit key |
115 | lives_ok (sub { |
116 | my @pop; |
117 | for (1..2) { |
118 | push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; |
119 | } |
17d59d97 |
120 | $ars->populate (\@pop); |
3a8aae80 |
121 | }); |
122 | |
123 | # count what we did so far |
124 | is ($ars->count, 6, 'Simple count works'); |
125 | |
72537d31 |
126 | # test UPDATE |
17d59d97 |
127 | lives_and { |
128 | $ars->search({ name => 'foo' })->update({ rank => 4 }); |
129 | |
dd2109ee |
130 | is eval { $ars->search({ name => 'foo' })->first->rank }, 4; |
72537d31 |
131 | } 'Can update a column'; |
132 | |
133 | my ($updated) = $schema->resultset('Artist')->search({name => 'foo'}); |
dd2109ee |
134 | is eval { $updated->rank }, 4, 'and the update made it to the database'; |
72537d31 |
135 | |
136 | |
3a8aae80 |
137 | # test LIMIT support |
138 | my $lim = $ars->search( {}, |
139 | { |
140 | rows => 3, |
141 | offset => 4, |
142 | order_by => 'artistid' |
143 | } |
144 | ); |
145 | is( $lim->count, 2, 'ROWS+OFFSET count ok' ); |
146 | is( $lim->all, 2, 'Number of ->all objects matches count' ); |
147 | |
148 | # test iterator |
149 | $lim->reset; |
dd2109ee |
150 | is( eval { $lim->next->artistid }, 101, "iterator->next ok" ); |
151 | is( eval { $lim->next->artistid }, 102, "iterator->next ok" ); |
3a8aae80 |
152 | is( $lim->next, undef, "next past end of resultset ok" ); |
153 | |
17d59d97 |
154 | # test multiple executing cursors |
155 | { |
156 | my $rs1 = $ars->search({}, { order_by => { -asc => 'artistid' }}); |
157 | my $rs2 = $ars->search({}, { order_by => { -desc => 'artistid' }}); |
158 | |
c13488fd |
159 | is $rs1->next->artistid, 1, 'multiple cursors'; |
160 | is $rs2->next->artistid, 102, 'multiple cursors'; |
17d59d97 |
161 | } |
162 | |
3a8aae80 |
163 | # test empty insert |
164 | { |
165 | local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; |
166 | |
167 | lives_ok { $ars->create({}) } |
168 | 'empty insert works'; |
169 | } |
170 | |
171 | # test blobs (stolen from 73oracle.t) |
145b2a3d |
172 | SKIP: { |
930689e6 |
173 | eval { $dbh->do('DROP TABLE "bindtype_test2"') }; |
145b2a3d |
174 | $dbh->do(q[ |
930689e6 |
175 | CREATE TABLE "bindtype_test2" |
145b2a3d |
176 | ( |
930689e6 |
177 | "id" INT PRIMARY KEY, |
178 | "bytea" INT, |
179 | "a_blob" BLOB, |
180 | "a_clob" BLOB SUB_TYPE TEXT |
145b2a3d |
181 | ) |
182 | ]); |
183 | |
145b2a3d |
184 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
185 | $binstr{'large'} = $binstr{'small'} x 1024; |
3a8aae80 |
186 | |
145b2a3d |
187 | my $maxloblen = length $binstr{'large'}; |
188 | local $dbh->{'LongReadLen'} = $maxloblen; |
3a8aae80 |
189 | |
90489c23 |
190 | my $rs = $schema->resultset('BindType2'); |
145b2a3d |
191 | my $id = 0; |
3a8aae80 |
192 | |
145b2a3d |
193 | foreach my $type (qw( a_blob a_clob )) { |
194 | foreach my $size (qw( small large )) { |
195 | $id++; |
3a8aae80 |
196 | |
197 | # turn off horrendous binary DBIC_TRACE output |
145b2a3d |
198 | local $schema->storage->{debug} = 0; |
3a8aae80 |
199 | |
145b2a3d |
200 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
201 | "inserted $size $type without dying"; |
3a8aae80 |
202 | |
145b2a3d |
203 | ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); |
204 | } |
3a8aae80 |
205 | } |
206 | } |
207 | } |
208 | |
209 | done_testing; |
210 | |
211 | # clean up our mess |
dff4c3a3 |
212 | |
213 | sub cleanup { |
145b2a3d |
214 | my $dbh; |
215 | eval { |
216 | $schema->storage->disconnect; # to avoid object FOO is in use errors |
217 | $dbh = $schema->storage->dbh; |
218 | }; |
219 | return unless $dbh; |
220 | |
930689e6 |
221 | eval { $dbh->do('DROP TRIGGER "artist_bi"') }; |
145b2a3d |
222 | diag $@ if $@; |
223 | |
930689e6 |
224 | eval { $dbh->do('DROP GENERATOR "gen_artist_artistid"') }; |
145b2a3d |
225 | diag $@ if $@; |
226 | |
9633951d |
227 | foreach my $table (qw/artist bindtype_test/) { |
228 | eval { $dbh->do(qq[DROP TABLE "$table"]) }; |
145b2a3d |
229 | #diag $@ if $@; |
3a8aae80 |
230 | } |
231 | } |