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 my $fail_code = sub {
104 $artist->create_related('cds', {
105 title => 'this should not exist',
108 die "the sky is falling";
111 # Test failed txn_do()
114 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
116 my $artist = $schema->resultset('Artist')->find(3);
119 $schema->txn_do($fail_code, $artist);
120 }, qr/the sky is falling/, 'failed txn_do threw an exception');
122 my $cd = $artist->cds({
123 title => 'this should not exist',
126 ok(!defined($cd), q{failed txn_do didn't change the cds table});
128 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
131 # do the same transaction again
133 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
135 my $artist = $schema->resultset('Artist')->find(3);
138 $schema->txn_do($fail_code, $artist);
139 }, qr/the sky is falling/, 'failed txn_do threw an exception');
141 my $cd = $artist->cds({
142 title => 'this should not exist',
145 ok(!defined($cd), q{failed txn_do didn't change the cds table});
147 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
150 # Test failed txn_do() with failed rollback
152 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
154 my $artist = $schema->resultset('Artist')->find(3);
156 # Force txn_rollback() to throw an exception
157 no warnings 'redefine';
161 local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{
168 $schema->txn_do($fail_code, $artist);
170 qr/the sky is falling.+Rollback failed/s,
171 'txn_rollback threw a rollback exception (and included the original exception'
174 my $cd = $artist->cds({
175 title => 'this should not exist',
178 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }.
179 q{changed the cds table});
180 $cd->delete; # Rollback failed
182 title => 'this should not exist',
185 ok(!defined($cd), q{deleted the failed txn's cd});
186 $schema->storage->_dbh->rollback;
190 # reset schema object (the txn_rollback meddling screws it up)
193 # Test nested failed txn_do()
195 my $schema = DBICTest->init_schema();
197 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
199 my $nested_fail_code = sub {
200 my ($schema, $artist, $code1, $code2) = @_;
202 my @titles = map {'nested txn_do test CD ' . $_} (1..5);
204 $schema->txn_do($code1, $artist, @titles); # successful txn
205 $schema->txn_do($code2, $artist); # failed txn
208 my $artist = $schema->resultset('Artist')->find(3);
211 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
212 }, qr/the sky is falling/, 'nested failed txn_do threw exception');
214 ok(!defined($artist->cds({
215 title => 'nested txn_do test CD '.$_,
217 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5);
218 my $cd = $artist->cds({
219 title => 'this should not exist',
222 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
225 # Grab a new schema to test txn before connect
227 my $schema = DBICTest->init_schema(no_deploy => 1);
229 $schema->txn_begin();
230 $schema->txn_begin();
231 }, 'Pre-connection nested transactions.');
233 # although not connected DBI would still warn about rolling back at disconnect
234 $schema->txn_rollback;
235 $schema->txn_rollback;
238 # Test txn_scope_guard
240 my $schema = DBICTest->init_schema();
242 is($schema->storage->transaction_depth, 0, "Correct transaction depth");
243 my $artist_rs = $schema->resultset('Artist');
247 my $guard = $schema->txn_scope_guard;
250 name => 'Death Cab for Cutie',
255 } qr/No such column made_up_column .*? at .*?$fn line \d+/s, "Error propogated okay";
257 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
259 my $inner_exception = ''; # set in inner() below
262 }, qr/$inner_exception/, "Nested exceptions propogated");
264 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
268 # this weird assignment is to stop perl <= 5.8.9 leaking $schema on nested sub{}s
271 warnings_exist ( sub {
272 # The 0 arg says don't die, just let the scope guard go out of scope
273 # forcing a txn_rollback to happen
275 }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected');
277 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created");
279 }, 'rollback successful withot exception');
282 my ($schema, $fatal) = @_;
284 my $guard = $schema->txn_scope_guard;
285 $schema->resultset('Artist')->create({
286 name => 'Death Cab for Cutie',
288 inner($schema, $fatal);
292 my ($schema, $fatal) = @_;
294 my $inner_guard = $schema->txn_scope_guard;
295 is($schema->storage->transaction_depth, 2, "Correct transaction depth");
297 my $artist = $schema->resultset('Artist')->find({ name => 'Death Cab for Cutie' });
300 $artist->cds->create({
303 $fatal ? ( foo => 'bar' ) : ()
307 # Record what got thrown so we can test it propgates out properly.
308 $inner_exception = $@;
312 # inner guard should commit without consequences
313 $inner_guard->commit;
317 # make sure the guard does not eat exceptions
319 my $schema = DBICTest->init_schema();
321 my $guard = $schema->txn_scope_guard;
322 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
324 $schema->storage->disconnect; # this should freak out the guard rollback
326 die 'Deliberate exception';
327 }, qr/Deliberate exception.+Rollback failed/s);
330 # make sure it warns *big* on failed rollbacks
332 my $schema = DBICTest->init_schema();
334 # something is really confusing Test::Warn here, no time to debug
338 my $guard = $schema->txn_scope_guard;
339 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
341 $schema->storage->disconnect; # this should freak out the guard rollback
344 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
345 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
347 'proper warnings generated on out-of-scope+rollback failure'
352 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
353 qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
357 local $SIG{__WARN__} = sub {
358 if (grep {$_[0] =~ $_} (@want)) {
366 my $guard = $schema->txn_scope_guard;
367 $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
369 $schema->storage->disconnect; # this should freak out the guard rollback
372 is (@w, 2, 'Both expected warnings found');
375 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
377 my $factory = DBICTest->init_schema (AutoCommit => 0);
378 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
379 my $dbh = $factory->storage->dbh;
381 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
382 my $schema = DBICTest::Schema->connect (sub { $dbh });
385 my $guard = $schema->txn_scope_guard;
386 $schema->resultset('CD')->delete;
388 }, 'No attempt to start a transaction with scope guard');
390 is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
392 # this will commit the implicitly started txn
395 } [], 'No warnings on AutoCommit => 0 with txn_guard';
397 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
399 my $factory = DBICTest->init_schema (AutoCommit => 0);
400 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete');
401 my $dbh = $factory->storage->dbh;
403 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
404 my $schema = DBICTest::Schema->connect (sub { $dbh });
408 $schema->txn_do (sub { $schema->resultset ('CD')->delete });
409 }, 'No attempt to start a atransaction with txn_do');
411 is ($schema->resultset('CD')->count, 0, 'Deletion successful');
413 # this will commit the implicitly started txn
416 } [], 'No warnings on AutoCommit => 0 with txn_do';