Audit and annotate all context-sensitive spots in ::Ordered

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / BlockRunner.pm

diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm
index ad9cbf7..64d5164 100644 (file)
--- a/lib/DBIx/Class/Storage/BlockRunner.pm
+++ b/lib/DBIx/Class/Storage/BlockRunner.pm
@@ -4,12 +4,10 @@ package # hide from pause until we figure it all out
 use warnings;
 use strict;
 
-use DBIx::Class::Exception;
 use DBIx::Class::Carp;
 use Context::Preserve 'preserve_context';
-use DBIx::Class::_Util qw(is_exception qsub);
+use DBIx::Class::_Util qw( is_exception qsub dbic_internal_try dbic_internal_catch );
 use Scalar::Util qw(weaken blessed reftype);
-use Try::Tiny;
 use Moo;
 use namespace::clean;
 
@@ -122,13 +120,13 @@ sub _run {
   my $run_err = '';
 
   return preserve_context {
-    try {
+    dbic_internal_try {
       if (defined $txn_init_depth) {
         $self->storage->txn_begin;
         $txn_begin_ok = 1;
       }
       $cref->( @$args );
-    } catch {
+    } dbic_internal_catch {
       $run_err = $_;
       (); # important, affects @_ below
     };
@@ -136,9 +134,14 @@ sub _run {
     my @res = @_;
 
     my $storage = $self->storage;
-    my $cur_depth = $storage->transaction_depth;
 
-    if (defined $txn_init_depth and ! is_exception $run_err) {
+    if (
+      defined $txn_init_depth
+        and
+      ! is_exception $run_err
+        and
+      defined( my $cur_depth = $storage->transaction_depth )
+    ) {
       my $delta_txn = (1 + $txn_init_depth) - $cur_depth;
 
       if ($delta_txn) {
@@ -151,7 +154,13 @@ sub _run {
         ) unless $delta_txn == 1 and $cur_depth == 0;
       }
       else {
-        $run_err = eval { $storage->txn_commit; 1 } ? '' : $@;
+        dbic_internal_try {
+          $storage->txn_commit;
+          1;
+        }
+        dbic_internal_catch {
+          $run_err = $_;
+        };
       }
     }
 
@@ -176,7 +185,13 @@ sub _run {
           # FIXME - we assume that $storage->{_dbh_autocommit} is there if
           # txn_init_depth is there, but this is a DBI-ism
           $txn_init_depth > ( $storage->{_dbh_autocommit} ? 0 : 1 )
-        ) or ! $self->retry_handler->($self)
+        )
+          or
+        ! do {
+          local $self->storage->{_in_do_block_retry_handler} = 1
+            unless $self->storage->{_in_do_block_retry_handler};
+          $self->retry_handler->($self)
+        }
       );
 
       # we got that far - let's retry