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