[Bast-commits] r7641 - in DBIx-Class/0.08/trunk: lib/DBIx/Class/Storage t

[ribasushi at dev.catalyst.perl.org]

Author: ribasushi
Date: 2009-09-12 10:46:51 +0000 (Sat, 12 Sep 2009)
New Revision: 7641

Modified:
   DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/TxnScopeGuard.pm
   DBIx-Class/0.08/trunk/t/81transactions.t
Log:
Even better localization of $@, and don't use Test::Warn for the time being, as something is freaking out Sub::UpLevel

Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/TxnScopeGuard.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/TxnScopeGuard.pm	2009-09-12 10:11:41 UTC (rev 7640)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/TxnScopeGuard.pm	2009-09-12 10:46:51 UTC (rev 7641)
@@ -25,30 +25,32 @@
 
   my $exception = $@;
 
-  carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
-    unless $exception;
-
-  my $rollback_exception;
   {
     local $@;
+
+    carp 'A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back.'
+      unless $exception;
+
     eval { $storage->txn_rollback };
-    $rollback_exception = $@;
-  }
+    my $rollback_exception = $@;
 
-  if ($rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
-    if ($exception) {
-      $@ = "Transaction aborted: ${exception} "
+    if ($rollback_exception && $rollback_exception !~ /DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION/) {
+      if ($exception) {
+        $exception = "Transaction aborted: ${exception} "
           ."Rollback failed: ${rollback_exception}";
+      }
+      else {
+        carp (join ' ',
+          "********************* ROLLBACK FAILED!!! ********************",
+          "\nA rollback operation failed after the guard went out of scope.",
+          'This is potentially a disastrous situation, check your data for',
+          "consistency: $rollback_exception"
+        );
+      }
     }
-    else {
-      carp (join ' ',
-        "********************* ROLLBACK FAILED!!! ********************",
-        "\nA rollback operation failed after the guard went out of scope.",
-        'This is potentially a disastrous situation, check your data for',
-        "consistency: $rollback_exception"
-      );
-    }
   }
+
+  $@ = $exception;
 }
 
 1;

Modified: DBIx-Class/0.08/trunk/t/81transactions.t
===================================================================
--- DBIx-Class/0.08/trunk/t/81transactions.t	2009-09-12 10:11:41 UTC (rev 7640)
+++ DBIx-Class/0.08/trunk/t/81transactions.t	2009-09-12 10:46:51 UTC (rev 7641)
@@ -333,7 +333,10 @@
 {
   my $schema = DBICTest->init_schema();
 
-  warnings_exist (sub {
+  # something is really confusing Test::Warn here, no time to debug
+=begin
+  warnings_exist (
+    sub {
       my $guard = $schema->txn_scope_guard;
       $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
 
@@ -345,6 +348,30 @@
     ],
     'proper warnings generated on out-of-scope+rollback failure'
   );
+=cut
+
+  my @want = (
+    qr/A DBIx::Class::Storage::TxnScopeGuard went out of scope without explicit commit or error. Rolling back./,
+    qr/\*+ ROLLBACK FAILED\!\!\! \*+/,
+  );
+
+  my @w;
+  local $SIG{__WARN__} = sub {
+    if (grep {$_[0] =~ $_} (@want)) {
+      push @w, $_[0];
+    }
+    else {
+      warn $_[0];
+    }
+  };
+  {
+      my $guard = $schema->txn_scope_guard;
+      $schema->resultset ('Artist')->create ({ name => 'bohhoo'});
+
+      $schema->storage->disconnect;  # this should freak out the guard rollback
+  }
+
+  is (@w, 2, 'Both expected warnings found');
 }
 
 done_testing;