5 require threads if $^O eq 'MSWin32'; # preload due to fork errors
15 my ($artist, @cd_titles) = @_;
17 $artist->create_related('cds', {
20 }) foreach (@cd_titles);
22 return $artist->cds->all;
25 # Test checking of parameters
27 my $schema = DBICTest->init_schema;
30 (ref $schema)->txn_do(sub{});
31 }, qr/storage/, "can't call txn_do without storage");
35 }, qr/must be a CODE reference/, '$coderef parameter check ok');
38 # Test successful txn_do() - scalar/list context
40 my $schema = DBICTest->init_schema;
42 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
44 my @titles = map {'txn_do test CD ' . $_} (1..5);
45 my $artist = $schema->resultset('Artist')->find(1);
46 my $count_before = $artist->cds->count;
50 @res = $schema->txn_do($code, $artist, @titles);
51 is(scalar @res, $count_before+5, 'successful txn added 5 cds');
54 $res[0] = $schema->txn_do($code, $artist, @titles);
55 is($res[0], $count_before+5, 'successful txn added 5 cds');
59 title => "txn_do test CD $_",
60 })->first->year, 2006, "new CD $_ year correct") for (1..5);
62 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
65 # Test txn_do() @_ aliasing support
67 my $schema = DBICTest->init_schema;
70 $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
71 is ($res, 'changed', "Arguments properly aliased for txn_do");
74 # Test nested successful txn_do()
76 my $schema = DBICTest->init_schema;
78 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
80 my $nested_code = sub {
81 my ($schema, $artist, $code) = @_;
83 my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
84 my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
86 $schema->txn_do($code, $artist, @titles1);
87 $schema->txn_do($code, $artist, @titles2);
90 my $artist = $schema->resultset('Artist')->find(2);
91 my $count_before = $artist->cds->count;
94 $schema->txn_do($nested_code, $schema, $artist, $code);
95 }, 'nested txn_do succeeded');
98 title => 'nested txn_do test CD '.$_,
99 })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10);
100 is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs');
102 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
105 # test nested txn_begin on fresh connection
107 my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1);
108 $schema->storage->ensure_connected;
110 is ($schema->storage->transaction_depth, 0, 'Start outside txn');
116 die "$$ starts in txn!" if $s->storage->transaction_depth != 0;
118 die "$$ not in txn!" if $s->storage->transaction_depth == 0;
119 $s->storage->dbh->do('SELECT 1') }
121 die "$$ did not finish txn!" if $s->storage->transaction_depth != 0;
125 $_[0]->storage->dbh->do('SELECT 1');
129 my $guard = $_[0]->txn_scope_guard;
130 $_[0]->storage->dbh->do('SELECT 1');
135 die "Unable to fork: $!\n"
147 is ($schema->storage->transaction_depth, 0, 'Parent still outside txn');
149 for my $pid (@pids) {
151 ok (! $?, "Child $pid exit ok");
155 # Test txn_do/scope_guard with forking: outer txn_do
157 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
159 for my $pass (1..2) {
161 # do something trying to destabilize the depth count
164 my $guard = $schema->txn_scope_guard;
165 $schema->txn_do( sub { die } );
167 is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' );
168 $schema->txn_do( sub {
169 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
173 $schema->txn_do ( sub { _test_forking_action ($schema, $pass) } );
177 # same test with outer guard
179 my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
181 for my $pass (1..2) {
183 # do something trying to destabilize the depth count
186 my $guard = $schema->txn_scope_guard;
187 $schema->txn_do( sub { die } );
189 is( $schema->storage->transaction_depth, 0, 'Transaction successfully aborted' );
190 $schema->txn_do( sub {
191 ok ($schema->storage->_dbh->do ('SELECT 1'), "Query after exceptions ok ($_)");
195 my $guard = $schema->txn_scope_guard;
196 my @pids = _test_forking_action ($schema, $pass);
201 sub _test_forking_action {
202 my ($schema, $pass) = @_;
206 SKIP: for my $count (1 .. 5) {
208 skip 'Weird DBI General Protection Faults, skip forking tests (RT#63104)', 5
212 die "Unable to fork: $!\n"
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 $$"});
238 for my $pid (@pids) {
240 ok (! $?, "Child $pid exit ok (pass $pass)");
243 # it is important to reap all children before checking the final db-state
244 # otherwise a deadlock may occur between the transactions running in the
245 # children and the query of the parent
246 for my $pid (@pids) {
247 isa_ok ($schema->resultset ('Artist')->find ({ name => "forking action $pid" }), 'DBIx::Class::Row');
251 my $fail_code = sub {
253 $artist->create_related('cds', {
254 title => 'this should not exist',
257 die "the sky is falling";
261 my $schema = DBICTest->init_schema;
263 # Test failed txn_do()
266 is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)");
268 my $artist = $schema->resultset('Artist')->find(3);
271 $schema->txn_do($fail_code, $artist);
272 }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)");
274 my $cd = $artist->cds({
275 title => 'this should not exist',
278 ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)});
280 is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)");
284 # Test failed txn_do() with failed rollback
286 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
288 my $artist = $schema->resultset('Artist')->find(3);
290 # Force txn_rollback() to throw an exception
291 no warnings qw/once redefine/;
293 # this should logically work just fine - but it does not,
294 # only direct override of the existing method dtrt
295 #local *DBIx::Class::Storage::DBI::SQLite::txn_rollback = sub { die 'FAILED' };
297 local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'FAILED' };
298 Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
302 $schema->txn_do($fail_code, $artist);
304 qr/the sky is falling.+Rollback failed/s,
305 'txn_rollback threw a rollback exception (and included the original exception'
308 my $cd = $artist->cds({
309 title => 'this should not exist',
312 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
313 q{changed the cds table});
314 $cd->delete; # Rollback failed
316 title => 'this should not exist',
319 ok(!defined($cd), q{deleted the failed txn's cd});
320 $schema->storage->_dbh->rollback;
324 # Test nested failed txn_do()
326 my $schema = DBICTest->init_schema();
328 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
330 my $nested_fail_code = sub {
331 my ($schema, $artist, $code1, $code2) = @_;
333 my @titles = map {'nested txn_do test CD ' . $_} (1..5);
335 $schema->txn_do($code1, $artist, @titles); # successful txn
336 $schema->txn_do($code2, $artist); # failed txn
339 my $artist = $schema->resultset('Artist')->find(3);
342 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
343 }, qr/the sky is falling/, 'nested failed txn_do threw exception');
345 ok(!defined($artist->cds({
346 title => 'nested txn_do test CD '.$_,
348 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
349 my $cd = $artist->cds({
350 title => 'this should not exist',
353 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
357 # Grab a new schema to test txn before connect
358 # also test nested txn exception
360 my $schema = DBICTest->init_schema(no_deploy => 1);
362 $schema->txn_begin();
363 $schema->txn_begin();
364 }, 'Pre-connection nested transactions.');
366 throws_ok( sub { $schema->txn_rollback }, 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION', 'got proper nested rollback exception' );
369 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
371 my $factory = DBICTest->init_schema;
372 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
373 my $dbh = $factory->storage->dbh;
374 $dbh->{AutoCommit} = 0;
376 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
377 my $schema = DBICTest::Schema->connect (sub { $dbh });
380 my $guard = $schema->txn_scope_guard;
381 $schema->resultset('CD')->delete;
383 }, 'No attempt to start a transaction with scope guard');
385 is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
387 # this will commit the implicitly started txn
390 } [], 'No warnings on AutoCommit => 0 with txn_guard';
392 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
394 my $factory = DBICTest->init_schema;
395 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
396 my $dbh = $factory->storage->dbh;
397 $dbh->{AutoCommit} = 0;
399 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
400 my $schema = DBICTest::Schema->connect (sub { $dbh });
403 $schema->txn_do (sub { $schema->resultset ('CD')->delete });
404 }, 'No attempt to start a atransaction with txn_do');
406 is ($schema->resultset('CD')->count, 0, 'Deletion successful');
408 # this will commit the implicitly started txn
411 } [], 'No warnings on AutoCommit => 0 with txn_do';