Commit | Line | Data |
a964a928 |
1 | use strict; |
68de9438 |
2 | use warnings; |
d867eeda |
3 | no warnings 'uninitialized'; |
a964a928 |
4 | |
5 | use Test::More; |
e0b2344f |
6 | use Test::Exception; |
199fbc45 |
7 | use DBIx::Class::Optional::Dependencies (); |
a964a928 |
8 | use lib qw(t/lib); |
9 | use DBICTest; |
2baff5da |
10 | |
6d5679b2 |
11 | my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_SYBASE_${_}" } qw/DSN USER PASS/}; |
12 | if (not ($dsn && $user)) { |
13 | plan skip_all => join ' ', |
14 | 'Set $ENV{DBICTEST_SYBASE_DSN}, _USER and _PASS to run this test.', |
15 | 'Warning: This test drops and creates the tables:', |
16 | "'artist', 'money_test' and 'bindtype_test'", |
17 | ; |
18 | }; |
19 | |
199fbc45 |
20 | plan skip_all => 'Test needs ' . DBIx::Class::Optional::Dependencies->req_missing_for ('test_rdbms_ase') |
21 | unless DBIx::Class::Optional::Dependencies->req_ok_for ('test_rdbms_ase'); |
22 | |
6d5679b2 |
23 | # first run the test without the lang variable set |
24 | # it is important to do this before module load, hence |
25 | # the subprocess before the optdep check |
26 | if ($ENV{LANG} and $ENV{LANG} ne 'C') { |
27 | my $oldlang = $ENV{LANG}; |
28 | local $ENV{LANG} = 'C'; |
a964a928 |
29 | |
6d5679b2 |
30 | pass ("Your lang is set to $oldlang - testing with C first"); |
5703eb14 |
31 | |
6d5679b2 |
32 | my @cmd = ($^X, __FILE__); |
33 | |
34 | # this is cheating, and may even hang here and there (testing on windows passed fine) |
35 | # will be replaced with Test::SubExec::Noninteractive in due course |
36 | require IPC::Open2; |
37 | IPC::Open2::open2(my $out, my $in, @cmd); |
38 | while (my $ln = <$out>) { |
39 | print " $ln"; |
40 | } |
41 | |
42 | wait; |
43 | ok (! $?, "Wstat $? from: @cmd"); |
d867eeda |
44 | } |
45 | |
46 | my @storage_types = ( |
95787afe |
47 | 'DBI::Sybase::ASE', |
48 | 'DBI::Sybase::ASE::NoBindVars', |
d867eeda |
49 | ); |
5ce107ad |
50 | eval "require DBIx::Class::Storage::$_;" for @storage_types; |
95787afe |
51 | |
d867eeda |
52 | my $schema; |
53 | my $storage_idx = -1; |
54 | |
55 | sub get_schema { |
56 | DBICTest::Schema->connect($dsn, $user, $pass, { |
57 | on_connect_call => [ |
58 | [ blob_setup => log_on_update => 1 ], # this is a safer option |
59 | ], |
60 | }); |
61 | } |
62 | |
63 | my $ping_count = 0; |
64 | { |
95787afe |
65 | my $ping = DBIx::Class::Storage::DBI::Sybase::ASE->can('_ping'); |
66 | *DBIx::Class::Storage::DBI::Sybase::ASE::_ping = sub { |
d867eeda |
67 | $ping_count++; |
68 | goto $ping; |
69 | }; |
70 | } |
71 | |
72 | for my $storage_type (@storage_types) { |
73 | $storage_idx++; |
74 | |
95787afe |
75 | unless ($storage_type eq 'DBI::Sybase::ASE') { # autodetect |
d867eeda |
76 | DBICTest::Schema->storage_type("::$storage_type"); |
77 | } |
61cfaef7 |
78 | |
d867eeda |
79 | $schema = get_schema(); |
a964a928 |
80 | |
d867eeda |
81 | $schema->storage->ensure_connected; |
a964a928 |
82 | |
d867eeda |
83 | if ($storage_idx == 0 && |
95787afe |
84 | $schema->storage->isa('DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars')) { |
6d5679b2 |
85 | # no placeholders in this version of Sybase or DBD::Sybase (or using FreeTDS) |
86 | skip "Skipping entire test for $storage_type - no placeholder support", 1; |
d867eeda |
87 | next; |
88 | } |
5703eb14 |
89 | |
d867eeda |
90 | isa_ok( $schema->storage, "DBIx::Class::Storage::$storage_type" ); |
6b1f5ef7 |
91 | |
d867eeda |
92 | $schema->storage->_dbh->disconnect; |
93 | lives_ok (sub { $schema->storage->dbh }, 'reconnect works'); |
64f4e691 |
94 | |
d867eeda |
95 | $schema->storage->dbh_do (sub { |
96 | my ($storage, $dbh) = @_; |
97 | eval { $dbh->do("DROP TABLE artist") }; |
98 | $dbh->do(<<'SQL'); |
a964a928 |
99 | CREATE TABLE artist ( |
d867eeda |
100 | artistid INT IDENTITY PRIMARY KEY, |
a964a928 |
101 | name VARCHAR(100), |
102 | rank INT DEFAULT 13 NOT NULL, |
d867eeda |
103 | charfield CHAR(10) NULL |
a964a928 |
104 | ) |
26283ee3 |
105 | SQL |
d867eeda |
106 | }); |
a964a928 |
107 | |
d867eeda |
108 | my %seen_id; |
a964a928 |
109 | |
d867eeda |
110 | # so we start unconnected |
111 | $schema->storage->disconnect; |
fcc2ec11 |
112 | |
26283ee3 |
113 | # test primary key handling |
d867eeda |
114 | my $new = $schema->resultset('Artist')->create({ name => 'foo' }); |
115 | ok($new->artistid > 0, "Auto-PK worked"); |
fcc2ec11 |
116 | |
d867eeda |
117 | $seen_id{$new->artistid}++; |
fcc2ec11 |
118 | |
d867eeda |
119 | # check redispatch to storage-specific insert when auto-detected storage |
95787afe |
120 | if ($storage_type eq 'DBI::Sybase::ASE') { |
d867eeda |
121 | DBICTest::Schema->storage_type('::DBI'); |
122 | $schema = get_schema(); |
123 | } |
124 | |
125 | $new = $schema->resultset('Artist')->create({ name => 'Artist 1' }); |
126 | is ( $seen_id{$new->artistid}, undef, 'id for Artist 1 is unique' ); |
127 | $seen_id{$new->artistid}++; |
128 | |
129 | # inserts happen in a txn, so we make sure it still works inside a txn too |
130 | $schema->txn_begin; |
131 | |
132 | for (2..6) { |
a964a928 |
133 | $new = $schema->resultset('Artist')->create({ name => 'Artist ' . $_ }); |
134 | is ( $seen_id{$new->artistid}, undef, "id for Artist $_ is unique" ); |
135 | $seen_id{$new->artistid}++; |
d867eeda |
136 | } |
a964a928 |
137 | |
d867eeda |
138 | $schema->txn_commit; |
a964a928 |
139 | |
d867eeda |
140 | # test simple count |
141 | is ($schema->resultset('Artist')->count, 7, 'count(*) of whole table ok'); |
142 | |
143 | # test LIMIT support |
144 | my $it = $schema->resultset('Artist')->search({ |
145 | artistid => { '>' => 0 } |
146 | }, { |
a0348159 |
147 | rows => 3, |
a0348159 |
148 | order_by => 'artistid', |
d867eeda |
149 | }); |
af9e4a5e |
150 | |
d867eeda |
151 | is( $it->count, 3, "LIMIT count ok" ); |
e19677ad |
152 | |
d867eeda |
153 | is( $it->next->name, "foo", "iterator->next ok" ); |
154 | $it->next; |
155 | is( $it->next->name, "Artist 2", "iterator->next ok" ); |
156 | is( $it->next, undef, "next past end of resultset ok" ); |
157 | |
158 | # now try with offset |
159 | $it = $schema->resultset('Artist')->search({}, { |
160 | rows => 3, |
161 | offset => 3, |
162 | order_by => 'artistid', |
163 | }); |
164 | |
165 | is( $it->count, 3, "LIMIT with offset count ok" ); |
166 | |
167 | is( $it->next->name, "Artist 3", "iterator->next ok" ); |
168 | $it->next; |
169 | is( $it->next->name, "Artist 5", "iterator->next ok" ); |
170 | is( $it->next, undef, "next past end of resultset ok" ); |
171 | |
172 | # now try a grouped count |
173 | $schema->resultset('Artist')->create({ name => 'Artist 6' }) |
174 | for (1..6); |
175 | |
176 | $it = $schema->resultset('Artist')->search({}, { |
177 | group_by => 'name' |
178 | }); |
179 | |
180 | is( $it->count, 7, 'COUNT of GROUP_BY ok' ); |
181 | |
2baff5da |
182 | # do an IDENTITY_INSERT |
d867eeda |
183 | { |
184 | no warnings 'redefine'; |
185 | |
186 | my @debug_out; |
187 | local $schema->storage->{debug} = 1; |
188 | local $schema->storage->debugobj->{callback} = sub { |
189 | push @debug_out, $_[1]; |
190 | }; |
191 | |
192 | my $txn_used = 0; |
193 | my $txn_commit = \&DBIx::Class::Storage::DBI::txn_commit; |
194 | local *DBIx::Class::Storage::DBI::txn_commit = sub { |
195 | $txn_used = 1; |
196 | goto &$txn_commit; |
197 | }; |
198 | |
199 | $schema->resultset('Artist') |
200 | ->create({ artistid => 999, name => 'mtfnpy' }); |
201 | |
2baff5da |
202 | ok((grep /IDENTITY_INSERT/i, @debug_out), 'IDENTITY_INSERT used'); |
d867eeda |
203 | |
204 | SKIP: { |
205 | skip 'not testing lack of txn on IDENTITY_INSERT with NoBindVars', 1 |
206 | if $storage_type =~ /NoBindVars/i; |
207 | |
208 | is $txn_used, 0, 'no txn on insert with IDENTITY_INSERT'; |
209 | } |
210 | } |
211 | |
2baff5da |
212 | # do an IDENTITY_UPDATE |
213 | { |
214 | my @debug_out; |
215 | local $schema->storage->{debug} = 1; |
216 | local $schema->storage->debugobj->{callback} = sub { |
217 | push @debug_out, $_[1]; |
218 | }; |
219 | |
220 | lives_and { |
221 | $schema->resultset('Artist') |
222 | ->find(999)->update({ artistid => 555 }); |
223 | ok((grep /IDENTITY_UPDATE/i, @debug_out)); |
224 | } 'IDENTITY_UPDATE used'; |
225 | $ping_count-- if $@; |
226 | } |
d867eeda |
227 | |
228 | my $bulk_rs = $schema->resultset('Artist')->search({ |
229 | name => { -like => 'bulk artist %' } |
230 | }); |
231 | |
0a9a9955 |
232 | # test insert_bulk using populate. |
2baff5da |
233 | SKIP: { |
234 | skip 'insert_bulk not supported', 4 |
d390bd3c |
235 | unless $storage_type !~ /NoBindVars/i; |
e06ad5d5 |
236 | |
2baff5da |
237 | lives_ok { |
238 | $schema->resultset('Artist')->populate([ |
239 | { |
240 | name => 'bulk artist 1', |
241 | charfield => 'foo', |
242 | }, |
243 | { |
244 | name => 'bulk artist 2', |
245 | charfield => 'foo', |
246 | }, |
247 | { |
248 | name => 'bulk artist 3', |
249 | charfield => 'foo', |
250 | }, |
251 | ]); |
252 | } 'insert_bulk via populate'; |
253 | |
254 | is $bulk_rs->count, 3, 'correct number inserted via insert_bulk'; |
255 | |
256 | is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, |
257 | 'column set correctly via insert_bulk'); |
258 | |
259 | my %bulk_ids; |
260 | @bulk_ids{map $_->artistid, $bulk_rs->all} = (); |
261 | |
262 | is ((scalar keys %bulk_ids), 3, |
263 | 'identities generated correctly in insert_bulk'); |
264 | |
265 | $bulk_rs->delete; |
266 | } |
e06ad5d5 |
267 | |
0a9a9955 |
268 | # make sure insert_bulk works a second time on the same connection |
269 | SKIP: { |
270 | skip 'insert_bulk not supported', 3 |
d390bd3c |
271 | unless $storage_type !~ /NoBindVars/i; |
0a9a9955 |
272 | |
273 | lives_ok { |
274 | $schema->resultset('Artist')->populate([ |
275 | { |
276 | name => 'bulk artist 1', |
277 | charfield => 'bar', |
278 | }, |
279 | { |
280 | name => 'bulk artist 2', |
281 | charfield => 'bar', |
282 | }, |
283 | { |
284 | name => 'bulk artist 3', |
285 | charfield => 'bar', |
286 | }, |
287 | ]); |
288 | } 'insert_bulk via populate called a second time'; |
289 | |
290 | is $bulk_rs->count, 3, |
291 | 'correct number inserted via insert_bulk'; |
292 | |
293 | is ((grep $_->charfield eq 'bar', $bulk_rs->all), 3, |
294 | 'column set correctly via insert_bulk'); |
295 | |
296 | $bulk_rs->delete; |
297 | } |
298 | |
299 | # test invalid insert_bulk (missing required column) |
300 | # |
301 | # There should be a rollback, reconnect and the next valid insert_bulk should |
302 | # succeed. |
303 | throws_ok { |
304 | $schema->resultset('Artist')->populate([ |
305 | { |
306 | charfield => 'foo', |
307 | } |
308 | ]); |
309 | } qr/no value or default|does not allow null|placeholders/i, |
310 | # The second pattern is the error from fallback to regular array insert on |
311 | # incompatible charset. |
312 | # The third is for ::NoBindVars with no syb_has_blk. |
313 | 'insert_bulk with missing required column throws error'; |
314 | |
d867eeda |
315 | # now test insert_bulk with IDENTITY_INSERT |
2baff5da |
316 | SKIP: { |
317 | skip 'insert_bulk not supported', 3 |
d390bd3c |
318 | unless $storage_type !~ /NoBindVars/i; |
e19677ad |
319 | |
2baff5da |
320 | lives_ok { |
321 | $schema->resultset('Artist')->populate([ |
322 | { |
323 | artistid => 2001, |
324 | name => 'bulk artist 1', |
325 | charfield => 'foo', |
326 | }, |
327 | { |
328 | artistid => 2002, |
329 | name => 'bulk artist 2', |
330 | charfield => 'foo', |
331 | }, |
332 | { |
333 | artistid => 2003, |
334 | name => 'bulk artist 3', |
335 | charfield => 'foo', |
336 | }, |
337 | ]); |
338 | } 'insert_bulk with IDENTITY_INSERT via populate'; |
339 | |
340 | is $bulk_rs->count, 3, |
341 | 'correct number inserted via insert_bulk with IDENTITY_INSERT'; |
342 | |
343 | is ((grep $_->charfield eq 'foo', $bulk_rs->all), 3, |
344 | 'column set correctly via insert_bulk with IDENTITY_INSERT'); |
345 | |
346 | $bulk_rs->delete; |
347 | } |
d867eeda |
348 | |
349 | # test correlated subquery |
350 | my $subq = $schema->resultset('Artist')->search({ artistid => { '>' => 3 } }) |
351 | ->get_column('artistid') |
352 | ->as_query; |
353 | my $subq_rs = $schema->resultset('Artist')->search({ |
354 | artistid => { -in => $subq } |
355 | }); |
356 | is $subq_rs->count, 11, 'correlated subquery'; |
357 | |
358 | # mostly stolen from the blob stuff Nniuq wrote for t/73oracle.t |
359 | SKIP: { |
587daa97 |
360 | skip 'TEXT/IMAGE support does not work with FreeTDS', 22 |
d867eeda |
361 | if $schema->storage->using_freetds; |
362 | |
363 | my $dbh = $schema->storage->_dbh; |
364 | { |
365 | local $SIG{__WARN__} = sub {}; |
366 | eval { $dbh->do('DROP TABLE bindtype_test') }; |
367 | |
368 | $dbh->do(qq[ |
8273e845 |
369 | CREATE TABLE bindtype_test |
d867eeda |
370 | ( |
f3a9ea3d |
371 | id INT IDENTITY PRIMARY KEY, |
372 | bytea IMAGE NULL, |
373 | blob IMAGE NULL, |
374 | clob TEXT NULL, |
375 | a_memo IMAGE NULL |
d867eeda |
376 | ) |
377 | ],{ RaiseError => 1, PrintError => 0 }); |
378 | } |
379 | |
380 | my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); |
381 | $binstr{'large'} = $binstr{'small'} x 1024; |
382 | |
383 | my $maxloblen = length $binstr{'large'}; |
8273e845 |
384 | |
d867eeda |
385 | if (not $schema->storage->using_freetds) { |
386 | $dbh->{'LongReadLen'} = $maxloblen * 2; |
387 | } else { |
388 | $dbh->do("set textsize ".($maxloblen * 2)); |
389 | } |
390 | |
391 | my $rs = $schema->resultset('BindType'); |
392 | my $last_id; |
393 | |
394 | foreach my $type (qw(blob clob)) { |
395 | foreach my $size (qw(small large)) { |
396 | no warnings 'uninitialized'; |
397 | |
0a9a9955 |
398 | my $created; |
399 | lives_ok { |
400 | $created = $rs->create( { $type => $binstr{$size} } ) |
401 | } "inserted $size $type without dying"; |
d867eeda |
402 | |
403 | $last_id = $created->id if $created; |
404 | |
0a9a9955 |
405 | lives_and { |
406 | ok($rs->find($last_id)->$type eq $binstr{$size}) |
407 | } "verified inserted $size $type"; |
d867eeda |
408 | } |
409 | } |
410 | |
689819e1 |
411 | $rs->delete; |
412 | |
0a9a9955 |
413 | # blob insert with explicit PK |
414 | # also a good opportunity to test IDENTITY_INSERT |
415 | lives_ok { |
416 | $rs->create( { id => 1, blob => $binstr{large} } ) |
417 | } 'inserted large blob without dying with manual PK'; |
d867eeda |
418 | |
0a9a9955 |
419 | lives_and { |
420 | ok($rs->find(1)->blob eq $binstr{large}) |
421 | } 'verified inserted large blob with manual PK'; |
d867eeda |
422 | |
423 | # try a blob update |
424 | my $new_str = $binstr{large} . 'mtfnpy'; |
425 | |
426 | # check redispatch to storage-specific update when auto-detected storage |
95787afe |
427 | if ($storage_type eq 'DBI::Sybase::ASE') { |
d867eeda |
428 | DBICTest::Schema->storage_type('::DBI'); |
429 | $schema = get_schema(); |
430 | } |
431 | |
0a9a9955 |
432 | lives_ok { |
433 | $rs->search({ id => 1 })->update({ blob => $new_str }) |
434 | } 'updated blob successfully'; |
435 | |
436 | lives_and { |
437 | ok($rs->find(1)->blob eq $new_str) |
438 | } 'verified updated blob'; |
d867eeda |
439 | |
2baff5da |
440 | # try a blob update with IDENTITY_UPDATE |
441 | lives_and { |
442 | $new_str = $binstr{large} . 'hlagh'; |
443 | $rs->find(1)->update({ id => 999, blob => $new_str }); |
444 | ok($rs->find(999)->blob eq $new_str); |
445 | } 'verified updated blob with IDENTITY_UPDATE'; |
7ef97d26 |
446 | |
d867eeda |
447 | ## try multi-row blob update |
448 | # first insert some blobs |
d867eeda |
449 | $new_str = $binstr{large} . 'foo'; |
0a9a9955 |
450 | lives_and { |
451 | $rs->delete; |
452 | $rs->create({ blob => $binstr{large} }) for (1..2); |
453 | $rs->update({ blob => $new_str }); |
454 | is((grep $_->blob eq $new_str, $rs->all), 2); |
455 | } 'multi-row blob update'; |
456 | |
457 | $rs->delete; |
458 | |
587daa97 |
459 | # now try insert_bulk with blobs and only blobs |
0a9a9955 |
460 | $new_str = $binstr{large} . 'bar'; |
461 | lives_ok { |
462 | $rs->populate([ |
463 | { |
0a9a9955 |
464 | blob => $binstr{large}, |
465 | clob => $new_str, |
466 | }, |
467 | { |
0a9a9955 |
468 | blob => $binstr{large}, |
469 | clob => $new_str, |
470 | }, |
471 | ]); |
472 | } 'insert_bulk with blobs does not die'; |
473 | |
474 | is((grep $_->blob eq $binstr{large}, $rs->all), 2, |
475 | 'IMAGE column set correctly via insert_bulk'); |
476 | |
477 | is((grep $_->clob eq $new_str, $rs->all), 2, |
478 | 'TEXT column set correctly via insert_bulk'); |
2baff5da |
479 | |
587daa97 |
480 | # now try insert_bulk with blobs and a non-blob which also happens to be an |
481 | # identity column |
482 | SKIP: { |
483 | skip 'no insert_bulk without placeholders', 4 |
484 | if $storage_type =~ /NoBindVars/i; |
485 | |
486 | $rs->delete; |
487 | $new_str = $binstr{large} . 'bar'; |
488 | lives_ok { |
489 | $rs->populate([ |
490 | { |
491 | id => 1, |
492 | bytea => 1, |
493 | blob => $binstr{large}, |
494 | clob => $new_str, |
f3a9ea3d |
495 | a_memo => 2, |
587daa97 |
496 | }, |
497 | { |
498 | id => 2, |
499 | bytea => 1, |
500 | blob => $binstr{large}, |
501 | clob => $new_str, |
f3a9ea3d |
502 | a_memo => 2, |
587daa97 |
503 | }, |
504 | ]); |
db66bc3f |
505 | } 'insert_bulk with blobs and explicit identity does NOT die'; |
587daa97 |
506 | |
507 | is((grep $_->blob eq $binstr{large}, $rs->all), 2, |
508 | 'IMAGE column set correctly via insert_bulk with identity'); |
509 | |
510 | is((grep $_->clob eq $new_str, $rs->all), 2, |
511 | 'TEXT column set correctly via insert_bulk with identity'); |
512 | |
513 | is_deeply [ map $_->id, $rs->all ], [ 1,2 ], |
514 | 'explicit identities set correctly via insert_bulk with blobs'; |
515 | } |
516 | |
d390bd3c |
517 | lives_and { |
518 | $rs->delete; |
519 | $rs->create({ blob => $binstr{large} }) for (1..2); |
520 | $rs->update({ blob => undef }); |
521 | is((grep !defined($_->blob), $rs->all), 2); |
522 | } 'blob update to NULL'; |
d867eeda |
523 | } |
524 | |
cd048330 |
525 | # test MONEY column support (and some other misc. stuff) |
d867eeda |
526 | $schema->storage->dbh_do (sub { |
527 | my ($storage, $dbh) = @_; |
528 | eval { $dbh->do("DROP TABLE money_test") }; |
529 | $dbh->do(<<'SQL'); |
530 | CREATE TABLE money_test ( |
531 | id INT IDENTITY PRIMARY KEY, |
cd048330 |
532 | amount MONEY DEFAULT $999.99 NULL |
d867eeda |
533 | ) |
534 | SQL |
535 | }); |
536 | |
cd048330 |
537 | my $rs = $schema->resultset('Money'); |
538 | |
539 | # test insert with defaults |
540 | lives_and { |
541 | $rs->create({}); |
542 | is((grep $_->amount == 999.99, $rs->all), 1); |
543 | } 'insert with all defaults works'; |
544 | $rs->delete; |
545 | |
d867eeda |
546 | # test insert transaction when there's an active cursor |
2baff5da |
547 | { |
d867eeda |
548 | my $artist_rs = $schema->resultset('Artist'); |
549 | $artist_rs->first; |
550 | lives_ok { |
551 | my $row = $schema->resultset('Money')->create({ amount => 100 }); |
552 | $row->delete; |
553 | } 'inserted a row with an active cursor'; |
554 | $ping_count-- if $@; # dbh_do calls ->connected |
555 | } |
556 | |
557 | # test insert in an outer transaction when there's an active cursor |
558 | TODO: { |
559 | local $TODO = 'this should work once we have eager cursors'; |
560 | |
561 | # clear state, or we get a deadlock on $row->delete |
562 | # XXX figure out why this happens |
563 | $schema->storage->disconnect; |
564 | |
565 | lives_ok { |
566 | $schema->txn_do(sub { |
567 | my $artist_rs = $schema->resultset('Artist'); |
568 | $artist_rs->first; |
569 | my $row = $schema->resultset('Money')->create({ amount => 100 }); |
570 | $row->delete; |
571 | }); |
572 | } 'inserted a row with an active cursor in outer txn'; |
573 | $ping_count-- if $@; # dbh_do calls ->connected |
574 | } |
575 | |
576 | # Now test money values. |
d867eeda |
577 | my $row; |
578 | lives_ok { |
579 | $row = $rs->create({ amount => 100 }); |
580 | } 'inserted a money value'; |
581 | |
cdf7f026 |
582 | cmp_ok eval { $rs->find($row->id)->amount }, '==', 100, |
583 | 'money value round-trip'; |
d867eeda |
584 | |
585 | lives_ok { |
586 | $row->update({ amount => 200 }); |
587 | } 'updated a money value'; |
588 | |
cdf7f026 |
589 | cmp_ok eval { $rs->find($row->id)->amount }, '==', 200, |
590 | 'updated money value round-trip'; |
d867eeda |
591 | |
592 | lives_ok { |
593 | $row->update({ amount => undef }); |
594 | } 'updated a money value to NULL'; |
595 | |
46891041 |
596 | lives_and { |
ca507a2f |
597 | my $null_amount = $rs->find($row->id)->amount; |
46891041 |
598 | is $null_amount, undef; |
599 | } 'updated money value to NULL round-trip'; |
6469dabf |
600 | |
601 | # Test computed columns and timestamps |
602 | $schema->storage->dbh_do (sub { |
603 | my ($storage, $dbh) = @_; |
604 | eval { $dbh->do("DROP TABLE computed_column_test") }; |
605 | $dbh->do(<<'SQL'); |
606 | CREATE TABLE computed_column_test ( |
607 | id INT IDENTITY PRIMARY KEY, |
608 | a_computed_column AS getdate(), |
609 | a_timestamp timestamp, |
8273e845 |
610 | charfield VARCHAR(20) DEFAULT 'foo' |
6469dabf |
611 | ) |
612 | SQL |
613 | }); |
614 | |
615 | require DBICTest::Schema::ComputedColumn; |
616 | $schema->register_class( |
617 | ComputedColumn => 'DBICTest::Schema::ComputedColumn' |
618 | ); |
619 | |
620 | ok (($rs = $schema->resultset('ComputedColumn')), |
621 | 'got rs for ComputedColumn'); |
622 | |
623 | lives_ok { $row = $rs->create({}) } |
624 | 'empty insert for a table with computed columns survived'; |
625 | |
626 | lives_ok { |
627 | $row->update({ charfield => 'bar' }) |
628 | } 'update of a table with computed columns survived'; |
d867eeda |
629 | } |
630 | |
631 | is $ping_count, 0, 'no pings'; |
f1358489 |
632 | |
6d5679b2 |
633 | done_testing; |
634 | |
a964a928 |
635 | # clean up our mess |
636 | END { |
d867eeda |
637 | if (my $dbh = eval { $schema->storage->_dbh }) { |
638 | eval { $dbh->do("DROP TABLE $_") } |
6469dabf |
639 | for qw/artist bindtype_test money_test computed_column_test/; |
d867eeda |
640 | } |
a964a928 |
641 | } |