Fix nested exception handling in txn().

ap · May 10, 2011 · 0b85387 · 0b85387
1 parent 5a5be8a
commit 0b85387
Show file tree

Hide file tree

Showing 3 changed files with 37 additions and 15 deletions.
diff --git a/Changes b/Changes
@@ -7,8 +7,8 @@ Revision history for Perl extension DBIx::Connector.
         Setting `AutoCommit` to false defeats the scoping behavior of `txn()`
         and therefore should not be used.
       - Nested exception handling now works properly in nested calls to
-        `run()` in fixup mode. Thanks to Mark Lawrence for the report (RT
-        #66974).
+        `run()` in fixup mode and in nested calls to `txn()` in all modes.
+        Thanks to Mark Lawrence for the report (RT #66974).
 
 0.44  2011-03-20T01:04:59
       - Fixed bug with the MySQL driver introduced by the auto-reconnection

diff --git a/lib/DBIx/Connector.pm b/lib/DBIx/Connector.pm
@@ -230,7 +230,8 @@ sub _txn_run {
         $dbh = $self->{_mode} eq 'ping' ? $self->dbh : $self->_dbh;
         unless ($dbh->FETCH('AutoCommit')) {
             local $self->{_in_run}  = 1;
-            @ret = _exec( $dbh, $code, $wantarray );
+            @ret = eval { _exec( $dbh, $code, $wantarray ) };
+            if ($err = $@) { return $errh->($err) for $err }
             return $wantarray ? @ret : $ret[0];
         }
         # If we get here, restore the original error.
@@ -262,15 +263,18 @@ sub _txn_fixup_run {
     my $driver = $self->driver;
 
     my $wantarray = wantarray;
-    my @ret;
+    my ($err, @ret);
     local $self->{_in_run}  = 1;
 
     unless ($dbh->FETCH('AutoCommit')) {
-        @ret = _exec( $dbh, $code, $wantarray );
-        return $wantarray ? @ret : $ret[0];
+        TRY: {
+            @ret = eval { _exec( $dbh, $code, $wantarray ) };
+            $err = $@;
+        }
+        if ($err) { return $errh->($err) for $err }
+        return wantarray ? @ret : $ret[0];
     }
 
-    my $err;
     TRY: {
         local $@;
         eval {

diff --git a/t/catch.t b/t/catch.t
@@ -2,7 +2,7 @@
 
 use strict;
 use warnings;
-use Test::More tests => 8;
+use Test::More tests => 11;
 #use Test::More 'no_plan';
 
 my $CLASS;
@@ -13,26 +13,44 @@ BEGIN {
 
 ok my $conn = $CLASS->new( 'dbi:ExampleP:dummy', '', '' ), 'Construct connector';
 
-sub inner {
+sub run_inner {
     shift->run(sub {
         die 'WTF!';
     }, catch => sub {
-        die 'inner said: '. $_;
+        die 'run_inner said: '. $_;
     });
 }
 
-sub outer {
+sub run_outer {
     shift->run(sub {
-        inner( $conn );
+        run_inner( $conn );
     }, catch => sub {
-        die 'outer said: '. $_;
+        die 'run_outer said: '. $_;
+    });
+}
+
+sub txn_inner {
+    shift->txn(sub {
+        die 'WTF!';
+    }, catch => sub {
+        die 'txn_inner said: '. $_;
+    });
+}
+
+sub txn_outer {
+    shift->txn(sub {
+        txn_inner( $conn );
+    }, catch => sub {
+        die 'txn_outer said: '. $_;
     });
 }
 
 foreach my $mode (qw/ping no_ping fixup/) {
     ok $conn->mode( $mode ), qq{Set mode to "$mode"};
     local $@;
-    eval { outer($conn); };
-    like $@, qr{outer said: inner said: WTF!}, "$mode mode should handle nesting";
+    eval { run_outer($conn); };
+    like $@, qr{run_outer said: run_inner said: WTF!}, "$mode run should handle nesting";
+    eval { txn_outer($conn); };
+    like $@, qr{txn_outer said: txn_inner said: WTF!}, "$mode txn should handle nesting";
 }