Fix annoying warnings on innocent looking MSSQL code

[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 0a8dded..9b5bdbc 100644 (file)
--- a/lib/DBIx/Class/Storage/BlockRunner.pm
+++ b/lib/DBIx/Class/Storage/BlockRunner.pm
@@ -7,7 +7,7 @@ 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 );
 use Scalar::Util qw(weaken blessed reftype);
 use Try::Tiny;
 use Moo;
@@ -122,7 +122,7 @@ 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;
@@ -156,7 +156,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;
+        }
+        catch {
+          $run_err = $_;
+        };
       }
     }
 
@@ -181,7 +187,12 @@ 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;
+          $self->retry_handler->($self)
+        }
       );
 
       # we got that far - let's retry