10 my $schema = DBICTest->init_schema();
13 my ($artist, @cd_titles) = @_;
15 $artist->create_related('cds', {
18 }) foreach (@cd_titles);
20 return $artist->cds->all;
23 # Test checking of parameters
26 (ref $schema)->txn_do(sub{});
27 }, qr/storage/, "can't call txn_do without storage");
31 }, qr/must be a CODE reference/, '$coderef parameter check ok');
34 # Test successful txn_do() - scalar context
36 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
38 my @titles = map {'txn_do test CD ' . $_} (1..5);
39 my $artist = $schema->resultset('Artist')->find(1);
40 my $count_before = $artist->cds->count;
41 my $count_after = $schema->txn_do($code, $artist, @titles);
42 is($count_after, $count_before+5, 'successful txn added 5 cds');
44 title => "txn_do test CD $_",
45 })->first->year, 2006, "new CD $_ year correct") for (1..5);
47 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
50 # Test successful txn_do() - list context
52 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
54 my @titles = map {'txn_do test CD ' . $_} (6..10);
55 my $artist = $schema->resultset('Artist')->find(1);
56 my $count_before = $artist->cds->count;
57 my @cds = $schema->txn_do($code, $artist, @titles);
58 is(scalar @cds, $count_before+5, 'added 5 CDs and returned in list context');
60 title => "txn_do test CD $_",
61 })->first->year, 2006, "new CD $_ year correct") for (6..10);
63 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
66 # Test txn_do() @_ aliasing support
69 $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
70 is ($res, 'changed', "Arguments properly aliased for txn_do");
73 # Test nested successful txn_do()
75 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
77 my $nested_code = sub {
78 my ($schema, $artist, $code) = @_;
80 my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
81 my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
83 $schema->txn_do($code, $artist, @titles1);
84 $schema->txn_do($code, $artist, @titles2);
87 my $artist = $schema->resultset('Artist')->find(2);
88 my $count_before = $artist->cds->count;
91 $schema->txn_do($nested_code, $schema, $artist, $code);
92 }, 'nested txn_do succeeded');
95 title => 'nested txn_do test CD '.$_,
96 })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
97 is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs');
99 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
102 # test nested txn_begin on fresh connection
104 my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1);
105 $schema->storage->ensure_connected;
107 is ($schema->storage->transaction_depth, 0, 'Start outside txn');
113 die "$$ starts in txn!" if $s->storage->transaction_depth != 0;
115 die "$$ not in txn!" if $s->storage->transaction_depth == 0;
116 $s->storage->dbh->do('SELECT 1') }
118 die "$$ did not finish txn!" if $s->storage->transaction_depth != 0;
122 $_[0]->storage->dbh->do('SELECT 1');
126 my $guard = $_[0]->txn_scope_guard;
127 $_[0]->storage->dbh->do('SELECT 1');
132 die "Unable to fork: $!\n"
133 if ! defined $pids[-1];
143 is ($schema->storage->transaction_depth, 0, 'Parent still outside txn');
145 for my $pid (@pids) {
147 ok (! $?, "Child $pid exit ok");
151 # Test txn_do/scope_guard with forking: outer txn_do
153 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
155 for my $pass (1..2) {
157 # do something trying to destabilize the depth count
160 my $guard = $schema->txn_scope_guard;
161 $schema->txn_do( sub { die } );
163 $schema->txn_do( sub {
164 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
168 for my $pid ( $schema->txn_do ( sub { _forking_action ($schema) } ) ) {
170 ok (! $?, "Child $pid exit ok (pass $pass)");
171 isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
176 # same test with outer guard
178 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
180 for my $pass (1..2) {
182 # do something trying to destabilize the depth count
185 my $guard = $schema->txn_scope_guard;
186 $schema->txn_do( sub { die } );
188 $schema->txn_do( sub {
189 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
194 my $guard = $schema->txn_scope_guard;
195 _forking_action ($schema);
198 for my $pid (@pids) {
200 ok (! $?, "Child $pid exit ok (pass $pass)");
201 isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
206 sub _forking_action {
213 die "Unable to fork: $!\n"
214 if ! defined $pids[-1];
221 $schema->txn_do (sub {
222 my $depth = $schema->storage->transaction_depth;
223 die "$$(txn_do)unexpected txn depth $depth!" if $depth != 1;
224 $schema->resultset ('Artist')->create ({ name => "forking action $$"});
228 my $guard = $schema->txn_scope_guard;
229 my $depth = $schema->storage->transaction_depth;
230 die "$$(scope_guard) unexpected txn depth $depth!" if $depth != 1;
231 $schema->resultset ('Artist')->create ({ name => "forking action $$"});
241 my $fail_code = sub {
243 $artist->create_related('cds', {
244 title => 'this should not exist',
247 die "the sky is falling";
250 # Test failed txn_do()
253 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
255 my $artist = $schema->resultset('Artist')->find(3);
258 $schema->txn_do($fail_code, $artist);
259 }, qr/the sky is falling/, 'failed txn_do threw an exception');
261 my $cd = $artist->cds({
262 title => 'this should not exist',
265 ok(!defined($cd), q{failed txn_do didn't change the cds table});
267 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
270 # do the same transaction again
272 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
274 my $artist = $schema->resultset('Artist')->find(3);
277 $schema->txn_do($fail_code, $artist);
278 }, qr/the sky is falling/, 'failed txn_do threw an exception');
280 my $cd = $artist->cds({
281 title => 'this should not exist',
284 ok(!defined($cd), q{failed txn_do didn't change the cds table});
286 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
289 # Test failed txn_do() with failed rollback
291 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
293 my $artist = $schema->resultset('Artist')->find(3);
295 # Force txn_rollback() to throw an exception
296 no warnings 'redefine';
300 local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{
307 $schema->txn_do($fail_code, $artist);
309 qr/the sky is falling.+Rollback failed/s,
310 'txn_rollback threw a rollback exception (and included the original exception'
313 my $cd = $artist->cds({
314 title => 'this should not exist',
317 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
318 q{changed the cds table});
319 $cd->delete; # Rollback failed
321 title => 'this should not exist',
324 ok(!defined($cd), q{deleted the failed txn's cd});
325 $schema->storage->_dbh->rollback;
329 # reset schema object (the txn_rollback meddling screws it up)
332 # Test nested failed txn_do()
334 my $schema = DBICTest->init_schema();
336 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
338 my $nested_fail_code = sub {
339 my ($schema, $artist, $code1, $code2) = @_;
341 my @titles = map {'nested txn_do test CD ' . $_} (1..5);
343 $schema->txn_do($code1, $artist, @titles); # successful txn
344 $schema->txn_do($code2, $artist); # failed txn
347 my $artist = $schema->resultset('Artist')->find(3);
350 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
351 }, qr/the sky is falling/, 'nested failed txn_do threw exception');
353 ok(!defined($artist->cds({
354 title => 'nested txn_do test CD '.$_,
356 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
357 my $cd = $artist->cds({
358 title => 'this should not exist',
361 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
364 # Grab a new schema to test txn before connect
366 my $schema = DBICTest->init_schema(no_deploy => 1);
368 $schema->txn_begin();
369 $schema->txn_begin();
370 }, 'Pre-connection nested transactions.');
372 # although not connected DBI would still warn about rolling back at disconnect
373 $schema->txn_rollback;
374 $schema->txn_rollback;
377 # Test txn_scope_guard
379 my $schema = DBICTest->init_schema();
381 is($schema->storage->transaction_depth, 0, "Correct transaction depth");
382 my $artist_rs = $schema->resultset('Artist');
386 my $guard = $schema->txn_scope_guard;
389 name => 'Death Cab for Cutie',
394 } qr/No such column made_up_column .*? at .*?$fn line \d+/s, "Error propogated okay";
396 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
398 my $inner_exception = ''; # set in inner() below
401 }, qr/$inner_exception/, "Nested exceptions propogated");
403 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
407 # this weird assignment is to stop perl <= 5.8.9 leaking $schema on nested sub{}s
410 warnings_exist ( sub {
411 # The 0 arg says don't die, just let the scope guard go out of scope
412 # forcing a txn_rollback to happen
414 }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected');
416 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
418 }, 'rollback successful withot exception');
421 my ($schema, $fatal) = @_;
423 my $guard = $schema->txn_scope_guard;
424 $schema->resultset('Artist')->create({
425 name => 'Death Cab for Cutie',
427 inner($schema, $fatal);
431 my ($schema, $fatal) = @_;
433 my $inner_guard = $schema->txn_scope_guard;
434 is($schema->storage->transaction_depth, 2, "Correct transaction depth");
436 my $artist = $schema->resultset('Artist')->find({ name => 'Death Cab for Cutie' });
439 $artist->cds->create({
442 $fatal ? ( foo => 'bar' ) : ()
446 # Record what got thrown so we can test it propgates out properly.
447 $inner_exception = $@;
451 # inner guard should commit without consequences
452 $inner_guard->commit;
456 # make sure the guard does not eat exceptions
458 my $schema = DBICTest->init_schema;
461 no warnings 'redefine';
462 local *{DBIx::Class::Storage::DBI::txn_rollback} = sub { die 'die die my darling' };
465 my $guard = $schema->txn_scope_guard;
466 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
468 # this should freak out the guard rollback
469 # but it won't work because DBD::SQLite is buggy
470 # instead just install a toxic rollback above
471 #$schema->storage->_dbh( $schema->storage->_dbh->clone );
473 die 'Deliberate exception';
474 }, qr/Deliberate exception.+Rollback failed/s);
477 # make sure it warns *big* on failed rollbacks
479 my $schema = DBICTest->init_schema();
482 no warnings 'redefine';
483 local *{DBIx::Class::Storage::DBI::txn_rollback} = sub { die 'die die my darling' };
485 #The warn from within a DESTROY callback freaks out Test::Warn, do it old-school
489 my $guard = $schema->txn_scope_guard;
490 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
492 # this should freak out the guard rollback
493 # but it won't work because DBD::SQLite is buggy
494 # instead just install a toxic rollback above
495 #$schema->storage->_dbh( $schema->storage->_dbh->clone );
498 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
499 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
501 'proper warnings generated on out-of-scope+rollback failure'
505 # delete this once the above works properly (same test)
507 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
508 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
512 local $SIG{__WARN__} = sub {
513 if (grep {$_[0] =~ $_} (@want)) {
521 my $guard = $schema->txn_scope_guard;
522 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
525 is (@w, 2, 'Both expected warnings found');
528 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
530 my $factory = DBICTest->init_schema (AutoCommit => 0);
531 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
532 my $dbh = $factory->storage->dbh;
534 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
535 my $schema = DBICTest::Schema->connect (sub { $dbh });
538 my $guard = $schema->txn_scope_guard;
539 $schema->resultset('CD')->delete;
541 }, 'No attempt to start a transaction with scope guard');
543 is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
545 # this will commit the implicitly started txn
548 } [], 'No warnings on AutoCommit => 0 with txn_guard';
550 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
552 my $factory = DBICTest->init_schema (AutoCommit => 0);
553 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
554 my $dbh = $factory->storage->dbh;
556 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
557 my $schema = DBICTest::Schema->connect (sub { $dbh });
561 $schema->txn_do (sub { $schema->resultset ('CD')->delete });
562 }, 'No attempt to start a atransaction with txn_do');
564 is ($schema->resultset('CD')->count, 0, 'Deletion successful');
566 # this will commit the implicitly started txn
569 } [], 'No warnings on AutoCommit => 0 with txn_do';