Commit | Line | Data |
c0329273 |
1 | BEGIN { do "./t/lib/ANFANG.pm" or die ( $@ || $! ) } |
2 | |
f200d74b |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use Test::More; |
7 | use Test::Exception; |
199fbc45 |
8 | use DBIx::Class::Optional::Dependencies (); |
bbf6a9a5 |
9 | use DBIx::Class::_Util 'scope_guard'; |
c0329273 |
10 | |
f200d74b |
11 | use DBICTest; |
12 | |
199fbc45 |
13 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SQLANYWHERE_${_}" } qw/DSN USER PASS/}; |
14 | my ($dsn2, $user2, $pass2) = @ENV{map { "DBICTEST_SQLANYWHERE_ODBC_${_}" } qw/DSN USER PASS/}; |
15 | |
16 | plan skip_all => 'Test needs ' . |
17 | (join ' or ', map { $_ ? $_ : () } |
18 | DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere'), |
19 | DBIx::Class::Optional::Dependencies->req_missing_for('test_rdbms_sqlanywhere_odbc')) |
20 | unless |
21 | $dsn && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere') |
22 | or |
23 | $dsn2 && DBIx::Class::Optional::Dependencies->req_ok_for('test_rdbms_sqlanywhere_odbc') |
24 | or |
25 | (not $dsn || $dsn2); |
26 | |
c7e85630 |
27 | DBICTest::Schema->load_classes('ArtistGUID'); |
28 | |
b341186f |
29 | # tests stolen from 748informix.t |
f200d74b |
30 | |
8ebb1b58 |
31 | plan skip_all => <<'EOF' unless $dsn || $dsn2; |
374f18f2 |
32 | Set $ENV{DBICTEST_SQLANYWHERE_DSN} and/or $ENV{DBICTEST_SQLANYWHERE_ODBC_DSN}, |
cf7b6654 |
33 | _USER and _PASS to run these tests |
34 | EOF |
35 | |
36 | my @info = ( |
37 | [ $dsn, $user, $pass ], |
38 | [ $dsn2, $user2, $pass2 ], |
39 | ); |
40 | |
548d1627 |
41 | my $schema; |
f200d74b |
42 | |
cf7b6654 |
43 | foreach my $info (@info) { |
44 | my ($dsn, $user, $pass) = @$info; |
f200d74b |
45 | |
cf7b6654 |
46 | next unless $dsn; |
f200d74b |
47 | |
548d1627 |
48 | $schema = DBICTest::Schema->connect($dsn, $user, $pass, { |
9cf3db6f |
49 | auto_savepoint => 1 |
50 | }); |
f200d74b |
51 | |
bbf6a9a5 |
52 | my $guard = scope_guard { cleanup($schema) }; |
cf7b6654 |
53 | |
548d1627 |
54 | my $dbh = $schema->storage->dbh; |
cf7b6654 |
55 | |
56 | eval { $dbh->do("DROP TABLE artist") }; |
57 | |
58 | $dbh->do(<<EOF); |
59 | CREATE TABLE artist ( |
60 | artistid INT IDENTITY PRIMARY KEY, |
61 | name VARCHAR(255) NULL, |
62 | charfield CHAR(10) NULL, |
63 | rank INT DEFAULT 13 |
64 | ) |
ed720bc5 |
65 | EOF |
f200d74b |
66 | |
cf7b6654 |
67 | my $ars = $schema->resultset('Artist'); |
68 | is ( $ars->count, 0, 'No rows at first' ); |
f200d74b |
69 | |
70 | # test primary key handling |
cf7b6654 |
71 | my $new = $ars->create({ name => 'foo' }); |
72 | ok($new->artistid, "Auto-PK worked"); |
f200d74b |
73 | |
74 | # test explicit key spec |
cf7b6654 |
75 | $new = $ars->create ({ name => 'bar', artistid => 66 }); |
76 | is($new->artistid, 66, 'Explicit PK worked'); |
77 | $new->discard_changes; |
78 | is($new->artistid, 66, 'Explicit PK assigned'); |
f200d74b |
79 | |
9cf3db6f |
80 | # test savepoints |
b9889595 |
81 | throws_ok { |
9cf3db6f |
82 | $schema->txn_do(sub { |
83 | eval { |
84 | $schema->txn_do(sub { |
85 | $ars->create({ name => 'in_savepoint' }); |
86 | die "rolling back savepoint"; |
87 | }); |
88 | }; |
89 | ok ((not $ars->search({ name => 'in_savepoint' })->first), |
90 | 'savepoint rolled back'); |
91 | $ars->create({ name => 'in_outer_txn' }); |
92 | die "rolling back outer txn"; |
93 | }); |
b9889595 |
94 | } qr/rolling back outer txn/, |
9cf3db6f |
95 | 'correct exception for rollback'; |
96 | |
97 | ok ((not $ars->search({ name => 'in_outer_txn' })->first), |
98 | 'outer txn rolled back'); |
99 | |
f200d74b |
100 | # test populate |
cf7b6654 |
101 | lives_ok (sub { |
102 | my @pop; |
103 | for (1..2) { |
104 | push @pop, { name => "Artist_$_" }; |
105 | } |
106 | $ars->populate (\@pop); |
107 | }); |
f200d74b |
108 | |
109 | # test populate with explicit key |
cf7b6654 |
110 | lives_ok (sub { |
111 | my @pop; |
112 | for (1..2) { |
113 | push @pop, { name => "Artist_expkey_$_", artistid => 100 + $_ }; |
114 | } |
115 | $ars->populate (\@pop); |
116 | }); |
f200d74b |
117 | |
118 | # count what we did so far |
cf7b6654 |
119 | is ($ars->count, 6, 'Simple count works'); |
f200d74b |
120 | |
121 | # test LIMIT support |
cf7b6654 |
122 | my $lim = $ars->search( {}, |
123 | { |
124 | rows => 3, |
125 | offset => 4, |
126 | order_by => 'artistid' |
127 | } |
128 | ); |
129 | is( $lim->count, 2, 'ROWS+OFFSET count ok' ); |
130 | is( $lim->all, 2, 'Number of ->all objects matches count' ); |
f200d74b |
131 | |
132 | # test iterator |
cf7b6654 |
133 | $lim->reset; |
134 | is( $lim->next->artistid, 101, "iterator->next ok" ); |
135 | is( $lim->next->artistid, 102, "iterator->next ok" ); |
136 | is( $lim->next, undef, "next past end of resultset ok" ); |
f200d74b |
137 | |
ed720bc5 |
138 | # test empty insert |
cf7b6654 |
139 | { |
140 | local $ars->result_source->column_info('artistid')->{is_auto_increment} = 0; |
ed720bc5 |
141 | |
cf7b6654 |
142 | lives_ok { $ars->create({}) } |
143 | 'empty insert works'; |
144 | } |
ed720bc5 |
145 | |
b341186f |
146 | # test blobs (stolen from 73oracle.t) |
cf7b6654 |
147 | eval { $dbh->do('DROP TABLE bindtype_test') }; |
148 | $dbh->do(qq[ |
149 | CREATE TABLE bindtype_test |
150 | ( |
f3a9ea3d |
151 | id INT NOT NULL PRIMARY KEY, |
152 | bytea INT NULL, |
153 | blob LONG BINARY NULL, |
154 | clob LONG VARCHAR NULL, |
155 | a_memo INT NULL |
cf7b6654 |
156 | ) |
157 | ],{ RaiseError => 1, PrintError => 1 }); |
158 | |
159 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
160 | $binstr{'large'} = $binstr{'small'} x 1024; |
161 | |
162 | my $maxloblen = length $binstr{'large'}; |
163 | local $dbh->{'LongReadLen'} = $maxloblen; |
164 | |
165 | my $rs = $schema->resultset('BindType'); |
166 | my $id = 0; |
167 | |
168 | foreach my $type (qw( blob clob )) { |
169 | foreach my $size (qw( small large )) { |
170 | $id++; |
b341186f |
171 | |
ed720bc5 |
172 | # turn off horrendous binary DBIC_TRACE output |
cf7b6654 |
173 | local $schema->storage->{debug} = 0; |
ed720bc5 |
174 | |
cf7b6654 |
175 | lives_ok { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) } |
176 | "inserted $size $type without dying"; |
b341186f |
177 | |
cf7b6654 |
178 | ok($rs->find($id)->$type eq $binstr{$size}, "verified inserted $size $type" ); |
179 | } |
b341186f |
180 | } |
8273e845 |
181 | |
548d1627 |
182 | my @uuid_types = qw/uniqueidentifier uniqueidentifierstr/; |
183 | |
4b3515a6 |
184 | # test uniqueidentifiers (and the cursor_class). |
185 | |
548d1627 |
186 | for my $uuid_type (@uuid_types) { |
187 | local $schema->source('ArtistGUID')->column_info('artistid')->{data_type} |
188 | = $uuid_type; |
189 | |
190 | local $schema->source('ArtistGUID')->column_info('a_guid')->{data_type} |
191 | = $uuid_type; |
192 | |
193 | $schema->storage->dbh_do (sub { |
194 | my ($storage, $dbh) = @_; |
b1bdb76d |
195 | eval { $dbh->do("DROP TABLE artist_guid") }; |
548d1627 |
196 | $dbh->do(<<"SQL"); |
b1bdb76d |
197 | CREATE TABLE artist_guid ( |
548d1627 |
198 | artistid $uuid_type NOT NULL, |
199 | name VARCHAR(100), |
200 | rank INT NOT NULL DEFAULT '13', |
201 | charfield CHAR(10) NULL, |
202 | a_guid $uuid_type, |
203 | primary key(artistid) |
204 | ) |
205 | SQL |
206 | }); |
207 | |
4b3515a6 |
208 | local $TODO = 'something wrong with uniqueidentifierstr over ODBC' |
209 | if $dsn =~ /:ODBC:/ && $uuid_type eq 'uniqueidentifierstr'; |
210 | |
548d1627 |
211 | my $row; |
212 | lives_ok { |
213 | $row = $schema->resultset('ArtistGUID')->create({ name => 'mtfnpy' }) |
214 | } 'created a row with a GUID'; |
215 | |
216 | ok( |
217 | eval { $row->artistid }, |
218 | 'row has GUID PK col populated', |
219 | ); |
220 | diag $@ if $@; |
221 | |
222 | ok( |
223 | eval { $row->a_guid }, |
224 | 'row has a GUID col with auto_nextval populated', |
225 | ); |
226 | diag $@ if $@; |
227 | |
e2741c7f |
228 | my $row_from_db; |
229 | lives_ok { |
230 | $row_from_db = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->first |
231 | }; |
4b3515a6 |
232 | |
e2741c7f |
233 | is( |
234 | eval { $row_from_db->artistid }, |
235 | $row->artistid, |
236 | 'PK GUID round trip (via ->search->next)' |
237 | ); |
4b3515a6 |
238 | |
e2741c7f |
239 | is( |
240 | eval { $row_from_db->a_guid }, |
241 | $row->a_guid, |
242 | 'NON-PK GUID round trip (via ->search->next)' |
243 | ); |
4b3515a6 |
244 | |
e2741c7f |
245 | lives_ok { |
246 | $row_from_db = $schema->resultset('ArtistGUID')->find($row->artistid) |
247 | }; |
4b3515a6 |
248 | |
e2741c7f |
249 | is( |
250 | eval { $row_from_db->artistid }, |
251 | $row->artistid, |
252 | 'PK GUID round trip (via ->find)' |
253 | ); |
4b3515a6 |
254 | |
e2741c7f |
255 | is( |
256 | eval { $row_from_db->a_guid }, |
257 | $row->a_guid, |
258 | 'NON-PK GUID round trip (via ->find)' |
259 | ); |
4b3515a6 |
260 | |
e2741c7f |
261 | lives_ok { |
262 | ($row_from_db) = $schema->resultset('ArtistGUID')->search({ name => 'mtfnpy' })->all |
263 | }; |
548d1627 |
264 | |
e2741c7f |
265 | is( |
266 | eval { $row_from_db->artistid }, |
267 | $row->artistid, |
268 | 'PK GUID round trip (via ->search->all)' |
269 | ); |
548d1627 |
270 | |
e2741c7f |
271 | is( |
272 | eval { $row_from_db->a_guid }, |
273 | $row->a_guid, |
274 | 'NON-PK GUID round trip (via ->search->all)' |
275 | ); |
548d1627 |
276 | } |
b341186f |
277 | } |
f200d74b |
278 | |
279 | done_testing; |
280 | |
548d1627 |
281 | sub cleanup { |
65d35121 |
282 | my $schema = shift; |
b1bdb76d |
283 | eval { $schema->storage->dbh->do("DROP TABLE $_") } |
284 | for qw/artist artist_guid bindtype_test/; |
f200d74b |
285 | } |