1use strict; 2use warnings; 3 4use Test::More; 5use Test::Warn; 6use Test::Exception; 7use lib qw(t/lib); 8use DBICTest; 9 10my $schema = DBICTest->init_schema(); 11 12my $code = sub { 13 my ($artist, @cd_titles) = @_; 14 15 $artist->create_related('cds', { 16 title => $_, 17 year => 2006, 18 }) foreach (@cd_titles); 19 20 return $artist->cds->all; 21}; 22 23# Test checking of parameters 24{ 25 throws_ok (sub { 26 (ref $schema)->txn_do(sub{}); 27 }, qr/storage/, "can't call txn_do without storage"); 28 29 throws_ok ( sub { 30 $schema->txn_do(''); 31 }, qr/must be a CODE reference/, '$coderef parameter check ok'); 32} 33 34# Test successful txn_do() - scalar context 35{ 36 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 37 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'); 43 is($artist->cds({ 44 title => "txn_do test CD $_", 45 })->first->year, 2006, "new CD $_ year correct") for (1..5); 46 47 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); 48} 49 50# Test successful txn_do() - list context 51{ 52 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 53 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'); 59 is($artist->cds({ 60 title => "txn_do test CD $_", 61 })->first->year, 2006, "new CD $_ year correct") for (6..10); 62 63 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); 64} 65 66# Test nested successful txn_do() 67{ 68 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 69 70 my $nested_code = sub { 71 my ($schema, $artist, $code) = @_; 72 73 my @titles1 = map {'nested txn_do test CD ' . $_} (1..5); 74 my @titles2 = map {'nested txn_do test CD ' . $_} (6..10); 75 76 $schema->txn_do($code, $artist, @titles1); 77 $schema->txn_do($code, $artist, @titles2); 78 }; 79 80 my $artist = $schema->resultset('Artist')->find(2); 81 my $count_before = $artist->cds->count; 82 83 lives_ok (sub { 84 $schema->txn_do($nested_code, $schema, $artist, $code); 85 }, 'nested txn_do succeeded'); 86 87 is($artist->cds({ 88 title => 'nested txn_do test CD '.$_, 89 })->first->year, 2006, qq{nested txn_do CD$_ year ok}) for (1..10); 90 is($artist->cds->count, $count_before+10, 'nested txn_do added all CDs'); 91 92 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); 93} 94 95my $fail_code = sub { 96 my ($artist) = @_; 97 $artist->create_related('cds', { 98 title => 'this should not exist', 99 year => 2005, 100 }); 101 die "the sky is falling"; 102}; 103 104# Test failed txn_do() 105{ 106 107 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 108 109 my $artist = $schema->resultset('Artist')->find(3); 110 111 throws_ok (sub { 112 $schema->txn_do($fail_code, $artist); 113 }, qr/the sky is falling/, 'failed txn_do threw an exception'); 114 115 my $cd = $artist->cds({ 116 title => 'this should not exist', 117 year => 2005, 118 })->first; 119 ok(!defined($cd), q{failed txn_do didn't change the cds table}); 120 121 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); 122} 123 124# do the same transaction again 125{ 126 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 127 128 my $artist = $schema->resultset('Artist')->find(3); 129 130 throws_ok (sub { 131 $schema->txn_do($fail_code, $artist); 132 }, qr/the sky is falling/, 'failed txn_do threw an exception'); 133 134 my $cd = $artist->cds({ 135 title => 'this should not exist', 136 year => 2005, 137 })->first; 138 ok(!defined($cd), q{failed txn_do didn't change the cds table}); 139 140 is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset'); 141} 142 143# Test failed txn_do() with failed rollback 144{ 145 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 146 147 my $artist = $schema->resultset('Artist')->find(3); 148 149 # Force txn_rollback() to throw an exception 150 no warnings 'redefine'; 151 no strict 'refs'; 152 153 # die in rollback, but maintain sanity for further tests ... 154 local *{"DBIx::Class::Storage::DBI::SQLite::txn_rollback"} = sub{ 155 my $storage = shift; 156 $storage->{transaction_depth}--; 157 die 'FAILED'; 158 }; 159 160 throws_ok ( 161 sub { 162 $schema->txn_do($fail_code, $artist); 163 }, 164 qr/the sky is falling.+Rollback failed/s, 165 'txn_rollback threw a rollback exception (and included the original exception' 166 ); 167 168 my $cd = $artist->cds({ 169 title => 'this should not exist', 170 year => 2005, 171 })->first; 172 isa_ok($cd, 'DBICTest::CD', q{failed txn_do with a failed txn_rollback }. 173 q{changed the cds table}); 174 $cd->delete; # Rollback failed 175 $cd = $artist->cds({ 176 title => 'this should not exist', 177 year => 2005, 178 })->first; 179 ok(!defined($cd), q{deleted the failed txn's cd}); 180 $schema->storage->_dbh->rollback; 181} 182 183# Test nested failed txn_do() 184{ 185 is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0'); 186 187 my $nested_fail_code = sub { 188 my ($schema, $artist, $code1, $code2) = @_; 189 190 my @titles = map {'nested txn_do test CD ' . $_} (1..5); 191 192 $schema->txn_do($code1, $artist, @titles); # successful txn 193 $schema->txn_do($code2, $artist); # failed txn 194 }; 195 196 my $artist = $schema->resultset('Artist')->find(3); 197 198 throws_ok ( sub { 199 $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code); 200 }, qr/the sky is falling/, 'nested failed txn_do threw exception'); 201 202 ok(!defined($artist->cds({ 203 title => 'nested txn_do test CD '.$_, 204 year => 2006, 205 })->first), qq{failed txn_do didn't add first txn's cd $_}) for (1..5); 206 my $cd = $artist->cds({ 207 title => 'this should not exist', 208 year => 2005, 209 })->first; 210 ok(!defined($cd), q{failed txn_do didn't add failed txn's cd}); 211} 212 213# Grab a new schema to test txn before connect 214{ 215 my $schema2 = DBICTest->init_schema(no_deploy => 1); 216 lives_ok (sub { 217 $schema2->txn_begin(); 218 $schema2->txn_begin(); 219 }, 'Pre-connection nested transactions.'); 220 221 # although not connected DBI would still warn about rolling back at disconnect 222 $schema2->txn_rollback; 223 $schema2->txn_rollback; 224 $schema2->storage->disconnect; 225} 226$schema->storage->disconnect; 227 228# Test txn_scope_guard 229{ 230 my $schema = DBICTest->init_schema(); 231 232 is($schema->storage->transaction_depth, 0, "Correct transaction depth"); 233 my $artist_rs = $schema->resultset('Artist'); 234 throws_ok { 235 my $guard = $schema->txn_scope_guard; 236 237 238 $artist_rs->create({ 239 name => 'Death Cab for Cutie', 240 made_up_column => 1, 241 }); 242 243 $guard->commit; 244 } qr/No such column made_up_column .*? at .*?81transactions.t line \d+/s, "Error propogated okay"; 245 246 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); 247 248 my $inner_exception = ''; # set in inner() below 249 throws_ok (sub { 250 outer($schema, 1); 251 }, qr/$inner_exception/, "Nested exceptions propogated"); 252 253 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); 254 255 lives_ok (sub { 256 warnings_exist ( sub { 257 # The 0 arg says don't die, just let the scope guard go out of scope 258 # forcing a txn_rollback to happen 259 outer($schema, 0); 260 }, qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 'Out of scope warning detected'); 261 ok(!$artist_rs->find({name => 'Death Cab for Cutie'}), "Artist not created"); 262 }, 'rollback successful withot exception'); 263 264 sub outer { 265 my ($schema) = @_; 266 267 my $guard = $schema->txn_scope_guard; 268 $schema->resultset('Artist')->create({ 269 name => 'Death Cab for Cutie', 270 }); 271 inner(@_); 272 } 273 274 sub inner { 275 my ($schema, $fatal) = @_; 276 277 my $inner_guard = $schema->txn_scope_guard; 278 is($schema->storage->transaction_depth, 2, "Correct transaction depth"); 279 280 my $artist = $artist_rs->find({ name => 'Death Cab for Cutie' }); 281 282 eval { 283 $artist->cds->create({ 284 title => 'Plans', 285 year => 2005, 286 $fatal ? ( foo => 'bar' ) : () 287 }); 288 }; 289 if ($@) { 290 # Record what got thrown so we can test it propgates out properly. 291 $inner_exception = $@; 292 die $@; 293 } 294 295 # inner guard should commit without consequences 296 $inner_guard->commit; 297 } 298} 299 300# make sure the guard does not eat exceptions 301{ 302 my $schema = DBICTest->init_schema(); 303 throws_ok (sub { 304 my $guard = $schema->txn_scope_guard; 305 $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); 306 307 $schema->storage->disconnect; # this should freak out the guard rollback 308 309 die 'Deliberate exception'; 310 }, qr/Deliberate exception.+Rollback failed/s); 311} 312 313# make sure it warns *big* on failed rollbacks 314{ 315 my $schema = DBICTest->init_schema(); 316 317 # something is really confusing Test::Warn here, no time to debug 318=begin 319 warnings_exist ( 320 sub { 321 my $guard = $schema->txn_scope_guard; 322 $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); 323 324 $schema->storage->disconnect; # this should freak out the guard rollback 325 }, 326 [ 327 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 328 qr/\*+ ROLLBACK FAILED\!\!\! \*+/, 329 ], 330 'proper warnings generated on out-of-scope+rollback failure' 331 ); 332=cut 333 334 my @want = ( 335 qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./, 336 qr/\*+ ROLLBACK FAILED\!\!\! \*+/, 337 ); 338 339 my @w; 340 local $SIG{__WARN__} = sub { 341 if (grep {$_[0] =~ $_} (@want)) { 342 push @w, $_[0]; 343 } 344 else { 345 warn $_[0]; 346 } 347 }; 348 { 349 my $guard = $schema->txn_scope_guard; 350 $schema->resultset ('Artist')->create ({ name => 'bohhoo'}); 351 352 $schema->storage->disconnect; # this should freak out the guard rollback 353 } 354 355 is (@w, 2, 'Both expected warnings found'); 356} 357 358# make sure AutoCommit => 0 on external handles behaves correctly with scope_guard 359{ 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; 363 364 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); 365 my $schema = DBICTest::Schema->connect (sub { $dbh }); 366 367 368 lives_ok ( sub { 369 my $guard = $schema->txn_scope_guard; 370 $schema->resultset('CD')->delete; 371 $guard->commit; 372 }, 'No attempt to start a transaction with scope guard'); 373 374 is ($schema->resultset('CD')->count, 0, 'Deletion successful'); 375} 376 377# make sure AutoCommit => 0 on external handles behaves correctly with txn_do 378{ 379 my $factory = DBICTest->init_schema (AutoCommit => 0); 380 cmp_ok ($factory->resultset('CD')->count, '>', 0, 'Something to delete'); 381 my $dbh = $factory->storage->dbh; 382 383 ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh'); 384 my $schema = DBICTest::Schema->connect (sub { $dbh }); 385 386 387 lives_ok ( sub { 388 $schema->txn_do (sub { $schema->resultset ('CD')->delete }); 389 }, 'No attempt to start a atransaction with txn_do'); 390 391 is ($schema->resultset('CD')->count, 0, 'Deletion successful'); 392} 393 394done_testing; 395