11 my ($artist, @cd_titles) = @_;
13 $artist->create_related('cds', {
16 }) foreach (@cd_titles);
21 # Test checking of parameters
23 my $schema = DBICTest->init_schema;
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/list context
36 my $schema = DBICTest->init_schema;
38 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
40 my @titles = map {'txn_do test CD ' . $_} (1..5);
41 my $artist = $schema->resultset('Artist')->find(1);
42 my $count_before = $artist->cds->count;
46 @res = $schema->txn_do($code, $artist, @titles);
47 is(scalar @res, $count_before+5, 'successful txn added 5 cds');
50 $res[0] = $schema->txn_do($code, $artist, @titles);
51 is($res[0], $count_before+5, 'successful txn added 5 cds');
55 title => "txn_do test CD $_",
56 })->first->year, 2006, "new CD $_ year correct") for (1..5);
58 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
61 # Test txn_do() @_ aliasing support
63 my $schema = DBICTest->init_schema;
66 $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
67 is ($res, 'changed', "Arguments properly aliased for txn_do");
70 # Test nested successful txn_do()
72 my $schema = DBICTest->init_schema;
74 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
76 my $nested_code = sub {
77 my ($schema, $artist, $code) = @_;
79 my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
80 my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
82 $schema->txn_do($code, $artist, @titles1);
83 $schema->txn_do($code, $artist, @titles2);
86 my $artist = $schema->resultset('Artist')->find(2);
87 my $count_before = $artist->cds->count;
90 $schema->txn_do($nested_code, $schema, $artist, $code);
91 }, 'nested txn_do succeeded');
94 title => 'nested txn_do test CD '.$_,
95 })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
96 is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs');
98 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
101 # test nested txn_begin on fresh connection
103 my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1);
104 $schema->storage->ensure_connected;
106 is ($schema->storage->transaction_depth, 0, 'Start outside txn');
112 die "$$ starts in txn!" if $s->storage->transaction_depth != 0;
114 die "$$ not in txn!" if $s->storage->transaction_depth == 0;
115 $s->storage->dbh->do('SELECT 1') }
117 die "$$ did not finish txn!" if $s->storage->transaction_depth != 0;
121 $_[0]->storage->dbh->do('SELECT 1');
125 my $guard = $_[0]->txn_scope_guard;
126 $_[0]->storage->dbh->do('SELECT 1');
131 die "Unable to fork: $!\n"
132 if ! defined $pids[-1];
142 is ($schema->storage->transaction_depth, 0, 'Parent still outside txn');
144 for my $pid (@pids) {
146 ok (! $?, "Child $pid exit ok");
150 # Test txn_do/scope_guard with forking: outer txn_do
152 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
154 for my $pass (1..2) {
156 # do something trying to destabilize the depth count
159 my $guard = $schema->txn_scope_guard;
160 $schema->txn_do( sub { die } );
162 $schema->txn_do( sub {
163 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
167 for my $pid ( $schema->txn_do ( sub { _forking_action ($schema) } ) ) {
169 ok (! $?, "Child $pid exit ok (pass $pass)");
170 isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
175 # same test with outer guard
177 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
179 for my $pass (1..2) {
181 # do something trying to destabilize the depth count
184 my $guard = $schema->txn_scope_guard;
185 $schema->txn_do( sub { die } );
187 $schema->txn_do( sub {
188 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
193 my $guard = $schema->txn_scope_guard;
194 _forking_action ($schema);
197 for my $pid (@pids) {
199 ok (! $?, "Child $pid exit ok (pass $pass)");
200 isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
205 sub _forking_action {
212 die "Unable to fork: $!\n"
213 if ! defined $pids[-1];
220 $schema->txn_do (sub {
221 my $depth = $schema->storage->transaction_depth;
222 die "$$(txn_do)unexpected txn depth $depth!" if $depth != 1;
223 $schema->resultset ('Artist')->create ({ name => "forking action $$"});
227 my $guard = $schema->txn_scope_guard;
228 my $depth = $schema->storage->transaction_depth;
229 die "$$(scope_guard) unexpected txn depth $depth!" if $depth != 1;
230 $schema->resultset ('Artist')->create ({ name => "forking action $$"});
240 my $fail_code = sub {
242 $artist->create_related('cds', {
243 title => 'this should not exist',
246 die "the sky is falling";
250 my $schema = DBICTest->init_schema;
252 # Test failed txn_do()
255 is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)");
257 my $artist = $schema->resultset('Artist')->find(3);
260 $schema->txn_do($fail_code, $artist);
261 }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)");
263 my $cd = $artist->cds({
264 title => 'this should not exist',
267 ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)});
269 is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)");
273 # Test failed txn_do() with failed rollback
275 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
277 my $artist = $schema->resultset('Artist')->find(3);
279 # Force txn_rollback() to throw an exception
280 no warnings 'redefine';
284 local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{
291 $schema->txn_do($fail_code, $artist);
293 qr/the sky is falling.+Rollback failed/s,
294 'txn_rollback threw a rollback exception (and included the original exception'
297 my $cd = $artist->cds({
298 title => 'this should not exist',
301 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
302 q{changed the cds table});
303 $cd->delete; # Rollback failed
305 title => 'this should not exist',
308 ok(!defined($cd), q{deleted the failed txn's cd});
309 $schema->storage->_dbh->rollback;
313 # Test nested failed txn_do()
315 my $schema = DBICTest->init_schema();
317 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
319 my $nested_fail_code = sub {
320 my ($schema, $artist, $code1, $code2) = @_;
322 my @titles = map {'nested txn_do test CD ' . $_} (1..5);
324 $schema->txn_do($code1, $artist, @titles); # successful txn
325 $schema->txn_do($code2, $artist); # failed txn
328 my $artist = $schema->resultset('Artist')->find(3);
331 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
332 }, qr/the sky is falling/, 'nested failed txn_do threw exception');
334 ok(!defined($artist->cds({
335 title => 'nested txn_do test CD '.$_,
337 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
338 my $cd = $artist->cds({
339 title => 'this should not exist',
342 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
345 # Grab a new schema to test txn before connect
347 my $schema = DBICTest->init_schema(no_deploy => 1);
349 $schema->txn_begin();
350 $schema->txn_begin();
351 }, 'Pre-connection nested transactions.');
353 # although not connected DBI would still warn about rolling back at disconnect
354 $schema->txn_rollback;
355 $schema->txn_rollback;
358 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
360 my $factory = DBICTest->init_schema (AutoCommit => 0);
361 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
362 my $dbh = $factory->storage->dbh;
364 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
365 my $schema = DBICTest::Schema->connect (sub { $dbh });
368 my $guard = $schema->txn_scope_guard;
369 $schema->resultset('CD')->delete;
371 }, 'No attempt to start a transaction with scope guard');
373 is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
375 # this will commit the implicitly started txn
378 } [], 'No warnings on AutoCommit => 0 with txn_guard';
380 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
382 my $factory = DBICTest->init_schema (AutoCommit => 0);
383 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
384 my $dbh = $factory->storage->dbh;
386 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
387 my $schema = DBICTest::Schema->connect (sub { $dbh });
391 $schema->txn_do (sub { $schema->resultset ('CD')->delete });
392 }, 'No attempt to start a atransaction with txn_do');
394 is ($schema->resultset('CD')->count, 0, 'Deletion successful');
396 # this will commit the implicitly started txn
399 } [], 'No warnings on AutoCommit => 0 with txn_do';