t/storage/txn.t

   1 use strict;
   2 use warnings;
   3
   4 BEGIN {
   5   require threads if $^O eq 'MSWin32'; # preload due to fork errors
   6 }
   7
   8 use Test::More;
   9 use Test::Warn;
  10 use Test::Exception;
  11 use lib qw(t/lib);
  12 use DBICTest;
  13
  14 my $code = sub {
  15   my ($artist, @cd_titles) = @_;
  16
  17   $artist->create_related('cds', {
  18     title => $_,
  19     year => 2006,
  20   }) foreach (@cd_titles);
  21
  22   return $artist->cds->all;
  23 };
  24
  25 # Test checking of parameters
  26 {
  27   my $schema = DBICTest->init_schema;
  28
  29   throws_ok (sub {
  30     (ref $schema)->txn_do(sub{});
  31   }, qr/storage/, "can't call txn_do without storage");
  32
  33   throws_ok ( sub {
  34     $schema->txn_do('');
  35   }, qr/must be a CODE reference/, '$coderef parameter check ok');
  36 }
  37
  38 # Test successful txn_do() - scalar/list context
  39 for my $want (0,1) {
  40   my $schema = DBICTest->init_schema;
  41
  42   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
  43
  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;
  47
  48   my @res;
  49   if ($want) {
  50     @res = $schema->txn_do($code, $artist, @titles);
  51     is(scalar @res, $count_before+5, 'successful txn added 5 cds');
  52   }
  53   else {
  54     $res[0] = $schema->txn_do($code, $artist, @titles);
  55     is($res[0], $count_before+5, 'successful txn added 5 cds');
  56   }
  57
  58   is($artist->cds({
  59     title => "txn_do test CD $_",
  60   })->first->year, 2006, "new CD $_ year correct") for (1..5);
  61
  62   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
  63 }
  64
  65 # Test txn_do() @_ aliasing support
  66 {
  67   my $schema = DBICTest->init_schema;
  68
  69   my $res = 'original';
  70   $schema->storage->txn_do (sub { $_[0] = 'changed' }, $res);
  71   is ($res, 'changed', "Arguments properly aliased for txn_do");
  72 }
  73
  74 # Test nested successful txn_do()
  75 {
  76   my $schema = DBICTest->init_schema;
  77
  78   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
  79
  80   my $nested_code = sub {
  81     my ($schema, $artist, $code) = @_;
  82
  83     my @titles1 = map {'nested txn_do test CD ' . $_} (1..5);
  84     my @titles2 = map {'nested txn_do test CD ' . $_} (6..10);
  85
  86     $schema->txn_do($code, $artist, @titles1);
  87     $schema->txn_do($code, $artist, @titles2);
  88   };
  89
  90   my $artist = $schema->resultset('Artist')->find(2);
  91   my $count_before = $artist->cds->count;
  92
  93   lives_ok (sub {
  94     $schema->txn_do($nested_code, $schema, $artist, $code);
  95   }, 'nested txn_do succeeded');
  96
  97   is($artist->cds({
  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');
 101
 102   is( $schema->storage->{transaction_depth}, 0, 'txn depth has been reset');
 103 }
 104
 105 # test nested txn_begin on fresh connection
 106 {
 107   my $schema = DBICTest->init_schema(sqlite_use_file => 1, no_deploy => 1);
 108   $schema->storage->ensure_connected;
 109
 110   is ($schema->storage->transaction_depth, 0, 'Start outside txn');
 111
 112   my @pids;
 113   for my $action (
 114     sub {
 115       my $s = shift;
 116       die "$$ starts in txn!" if $s->storage->transaction_depth != 0;
 117       $s->txn_do ( sub {
 118         die "$$ not in txn!" if $s->storage->transaction_depth == 0;
 119         $s->storage->dbh->do('SELECT 1') }
 120       );
 121       die "$$ did not finish txn!" if $s->storage->transaction_depth != 0;
 122     },
 123     sub {
 124       $_[0]->txn_begin;
 125       $_[0]->storage->dbh->do('SELECT 1');
 126       $_[0]->txn_commit
 127     },
 128     sub {
 129       my $guard = $_[0]->txn_scope_guard;
 130       $_[0]->storage->dbh->do('SELECT 1');
 131       $guard->commit
 132     },
 133   ) {
 134     my $pid = fork();
 135     die "Unable to fork: $!\n"
 136       if ! defined $pid;
 137
 138     if ($pid) {
 139       push @pids, $pid;
 140       next;
 141     }
 142
 143     $action->($schema);
 144     exit 0;
 145   }
 146
 147   is ($schema->storage->transaction_depth, 0, 'Parent still outside txn');
 148
 149   for my $pid (@pids) {
 150     waitpid ($pid, 0);
 151     ok (! $?, "Child $pid exit ok");
 152   }
 153 }
 154
 155 # Test txn_do/scope_guard with forking: outer txn_do
 156 {
 157   my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
 158
 159   for my $pass (1..2) {
 160
 161     # do something trying to destabilize the depth count
 162     for (1..2) {
 163       eval {
 164         my $guard = $schema->txn_scope_guard;
 165         $schema->txn_do( sub { die } );
 166       };
 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 ($_)");
 170       });
 171     }
 172
 173     $schema->txn_do ( sub { _test_forking_action ($schema, $pass) } );
 174   }
 175 }
 176
 177 # same test with outer guard
 178 {
 179   my $schema = DBICTest->init_schema( sqlite_use_file => 1 );
 180
 181   for my $pass (1..2) {
 182
 183     # do something trying to destabilize the depth count
 184     for (1..2) {
 185       eval {
 186         my $guard = $schema->txn_scope_guard;
 187         $schema->txn_do( sub { die } );
 188       };
 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 ($_)");
 192       });
 193     }
 194
 195     my $guard = $schema->txn_scope_guard;
 196     my @pids = _test_forking_action ($schema, $pass);
 197     $guard->commit;
 198   }
 199 }
 200
 201 sub _test_forking_action {
 202   my ($schema, $pass) = @_;
 203
 204   my @pids;
 205
 206   SKIP: for my $count (1 .. 5) {
 207
 208     skip 'Weird DBI General Protection Faults, skip forking tests (RT#63104)', 5
 209       if $^O eq 'MSWin32';
 210
 211     my $pid = fork();
 212     die "Unable to fork: $!\n"
 213       if ! defined $pid;
 214
 215     if ($pid) {
 216       push @pids, $pid;
 217       next;
 218     }
 219
 220     if ($count % 2) {
 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 $$"});
 225       });
 226     }
 227     else {
 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 $$"});
 232       $guard->commit;
 233     }
 234
 235     exit 0;
 236   }
 237
 238   for my $pid (@pids) {
 239     waitpid ($pid, 0);
 240     ok (! $?, "Child $pid exit ok (pass $pass)");
 241   }
 242
 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');
 248   }
 249 }
 250
 251 my $fail_code = sub {
 252   my ($artist) = @_;
 253   $artist->create_related('cds', {
 254     title => 'this should not exist',
 255     year => 2005,
 256   });
 257   die "the sky is falling";
 258 };
 259
 260 {
 261   my $schema = DBICTest->init_schema;
 262
 263   # Test failed txn_do()
 264   for my $pass (1,2) {
 265
 266     is( $schema->storage->{transaction_depth}, 0, "txn depth starts at 0 (pass $pass)");
 267
 268     my $artist = $schema->resultset('Artist')->find(3);
 269
 270     throws_ok (sub {
 271       $schema->txn_do($fail_code, $artist);
 272     }, qr/the sky is falling/, "failed txn_do threw an exception (pass $pass)");
 273
 274     my $cd = $artist->cds({
 275       title => 'this should not exist',
 276       year => 2005,
 277     })->first;
 278     ok(!defined($cd), qq{failed txn_do didn't change the cds table (pass $pass)});
 279
 280     is( $schema->storage->{transaction_depth}, 0, "txn depth has been reset (pass $pass)");
 281   }
 282
 283
 284   # Test failed txn_do() with failed rollback
 285   {
 286     is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
 287
 288     my $artist = $schema->resultset('Artist')->find(3);
 289
 290     # Force txn_rollback() to throw an exception
 291     no warnings qw/once redefine/;
 292
 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' };
 296
 297     local *DBIx::Class::Storage::DBI::txn_rollback = sub { die 'FAILED' };
 298     Class::C3->reinitialize() if DBIx::Class::_ENV_::OLD_MRO;
 299
 300     throws_ok (
 301       sub {
 302         $schema->txn_do($fail_code, $artist);
 303       },
 304       qr/the sky is falling.+Rollback failed/s,
 305       'txn_rollback threw a rollback exception (and included the original exception'
 306     );
 307
 308     my $cd = $artist->cds({
 309       title => 'this should not exist',
 310       year => 2005,
 311     })->first;
 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
 315     $cd = $artist->cds({
 316       title => 'this should not exist',
 317       year => 2005,
 318     })->first;
 319     ok(!defined($cd), q{deleted the failed txn's cd});
 320     $schema->storage->_dbh->rollback;
 321   }
 322 }
 323
 324 # Test nested failed txn_do()
 325 {
 326   my $schema = DBICTest->init_schema();
 327
 328   is( $schema->storage->{transaction_depth}, 0, 'txn depth starts at 0');
 329
 330   my $nested_fail_code = sub {
 331     my ($schema, $artist, $code1, $code2) = @_;
 332
 333     my @titles = map {'nested txn_do test CD ' . $_} (1..5);
 334
 335     $schema->txn_do($code1, $artist, @titles); # successful txn
 336     $schema->txn_do($code2, $artist);          # failed txn
 337   };
 338
 339   my $artist = $schema->resultset('Artist')->find(3);
 340
 341   throws_ok ( sub {
 342     $schema->txn_do($nested_fail_code, $schema, $artist, $code, $fail_code);
 343   }, qr/the sky is falling/, 'nested failed txn_do threw exception');
 344
 345   ok(!defined($artist->cds({
 346     title => 'nested txn_do test CD '.$_,
 347     year => 2006,
 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',
 351     year => 2005,
 352   })->first;
 353   ok(!defined($cd), q{failed txn_do didn't add failed txn's cd});
 354 }
 355
 356
 357 # Grab a new schema to test txn before connect
 358 # also test nested txn exception
 359 {
 360   my $schema = DBICTest->init_schema(no_deploy => 1);
 361   lives_ok (sub {
 362     $schema->txn_begin();
 363     $schema->txn_begin();
 364   }, 'Pre-connection nested transactions.');
 365
 366   throws_ok( sub { $schema->txn_rollback }, 'DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION', 'got proper nested rollback exception' );
 367 }
 368
 369 # make sure AutoCommit => 0 on external handles behaves correctly with scope_guard
 370 warnings_are {
 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;
 375
 376   ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
 377   my $schema = DBICTest::Schema->connect (sub { $dbh });
 378
 379   lives_ok ( sub {
 380     my $guard = $schema->txn_scope_guard;
 381     $schema->resultset('CD')->delete;
 382     $guard->commit;
 383   }, 'No attempt to start a transaction with scope guard');
 384
 385   is ($schema->resultset('CD')->count, 0, 'Deletion successful in txn');
 386
 387   # this will commit the implicitly started txn
 388   $dbh->commit;
 389
 390 } [], 'No warnings on AutoCommit => 0 with txn_guard';
 391
 392 # make sure AutoCommit => 0 on external handles behaves correctly with txn_do
 393 warnings_are {
 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;
 398
 399   ok (!$dbh->{AutoCommit}, 'AutoCommit is off on $dbh');
 400   my $schema = DBICTest::Schema->connect (sub { $dbh });
 401
 402   lives_ok ( sub {
 403     $schema->txn_do (sub { $schema->resultset ('CD')->delete });
 404   }, 'No attempt to start a atransaction with txn_do');
 405
 406   is ($schema->resultset('CD')->count, 0, 'Deletion successful');
 407
 408   # this will commit the implicitly started txn
 409   $dbh->commit;
 410
 411 } [], 'No warnings on AutoCommit => 0 with txn_do';
 412
 413 done_testing;