X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=ad1770eb91c8aa642bbea25477015d5b8bdad373;hb=398215b170197df314fb0c40e0654c3a6860f19d;hp=0e162cf496ae8d56e9d7f53ca4a2d92ae75262ab;hpb=11544e1d2d3ef6c010616c061563996a3b10df37;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index 0e162cf..ad1770e 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -13,6 +13,7 @@ use mro 'c3';
 }
 
 use DBIx::Class::Carp;
+use DBIx::Class::Storage::BlockRunner;
 use Scalar::Util qw/blessed weaken/;
 use DBIx::Class::Storage::TxnScopeGuard;
 use Try::Tiny;
@@ -174,88 +175,16 @@ transaction failure.
 
 sub txn_do {
   my $self = shift;
-  my $coderef = shift;
 
-  ref $coderef eq 'CODE' or $self->throw_exception
-    ('$coderef must be a CODE reference');
-
-  my $abort_txn = sub {
-    my ($self, $exception) = @_;
-
-    my $rollback_exception = try { $self->txn_rollback; undef } catch { shift };
-
-    if ( $rollback_exception and (
-      ! defined blessed $rollback_exception
-          or
-      ! $rollback_exception->isa('DBIx::Class::Storage::NESTED_ROLLBACK_EXCEPTION')
-    ) ) {
-      $self->throw_exception(
-        "Transaction aborted: ${exception}. "
-        . "Rollback failed: ${rollback_exception}"
-      );
-    }
-    $self->throw_exception($exception);
-  };
-
-  # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
-  my $args = \@_;
-
-  # do not turn on until a succesful txn_begin
-  my $attempt_commit = 0;
-
-  my $txn_init_depth = $self->transaction_depth;
-
-  try {
-    $self->txn_begin;
-    $attempt_commit = 1;
-    $coderef->(@$args)
-  }
-  catch {
-    $attempt_commit = 0;
-
-    # init depth of > 0 implies nesting or non-autocommit (either way no retry)
-    if($txn_init_depth or $self->connected ) {
-      $abort_txn->($self, $_);
-    }
-    else {
-      carp "Retrying txn_do($coderef) after catching disconnected exception: $_"
-        if $ENV{DBIC_STORAGE_RETRY_DEBUG};
-
-      $self->_populate_dbh;
-
-      # if txn_depth is > 1 this means something was done to the
-      # original $dbh, otherwise we would not get past the if() above
-      $self->throw_exception(sprintf
-        'Unexpected transaction depth of %d on freshly connected handle',
-        $self->transaction_depth,
-      ) if $self->transaction_depth;
-
-      $self->txn_begin;
-      $attempt_commit = 1;
-
-      try {
-        $coderef->(@$args)
-      }
-      catch {
-        $attempt_commit = 0;
-        $abort_txn->($self, $_)
-      };
-    };
-  }
-  finally {
-    if ($attempt_commit) {
-      my $delta_txn = (1 + $txn_init_depth) - $self->transaction_depth;
-
-      if ($delta_txn) {
-        # a rollback in a top-level txn_do is valid-ish (seen in the wild and our own tests)
-        carp "Unexpected reduction of transaction depth by $delta_txn after execution of $coderef, skipping txn_do's commit"
-          unless $delta_txn == 1 and $self->transaction_depth == 0;
-      }
-      else {
-        $self->txn_commit;
-      }
-    }
-  };
+  DBIx::Class::Storage::BlockRunner->new(
+    storage => $self,
+    wrap_txn => 1,
+    retry_handler => sub {
+      $_[0]->failed_attempt_count == 1
+        and
+      ! $_[0]->storage->connected
+    },
+  )->run(@_);
 }
 
 =head2 txn_begin
@@ -298,6 +227,7 @@ sub txn_commit {
     $self->debugobj->txn_commit() if $self->debug;
     $self->_exec_txn_commit;
     $self->{transaction_depth}--;
+    $self->savepoints([]);
   }
   elsif($self->transaction_depth > 1) {
     $self->{transaction_depth}--;
@@ -323,6 +253,7 @@ sub txn_rollback {
     $self->debugobj->txn_rollback() if $self->debug;
     $self->_exec_txn_rollback;
     $self->{transaction_depth}--;
+    $self->savepoints([]);
   }
   elsif ($self->transaction_depth > 1) {
     $self->{transaction_depth}--;
@@ -467,8 +398,8 @@ L<DBIx::Class::Storage::TxnScopeGuard>:
 
  my $txn_guard = $storage->txn_scope_guard;
 
- $row->col1("val1");
- $row->update;
+ $result->col1("val1");
+ $result->update;
 
  $txn_guard->commit;
 
@@ -506,7 +437,7 @@ shell environment.
 =head2 debugfh
 
 Set or retrieve the filehandle used for trace/debug output.  This should be
-an IO::Handle compatible object (only the C<print> method is used.  Initially
+an IO::Handle compatible object (only the C<print> method is used).  Initially
 set to be STDERR - although see information on the
 L<DBIC_TRACE> environment variable.
 
@@ -539,6 +470,8 @@ sub debugobj {
   $self->{debugobj} ||= do {
     if (my $profile = $ENV{DBIC_TRACE_PROFILE}) {
       require DBIx::Class::Storage::Debug::PrettyPrint;
+      my @pp_args;
+
       if ($profile =~ /^\.?\//) {
         require Config::Any;
 
@@ -550,10 +483,28 @@ sub debugobj {
           $self->throw_exception("Failure processing \$ENV{DBIC_TRACE_PROFILE}: $_");
         };
 
-        DBIx::Class::Storage::Debug::PrettyPrint->new(values %{$cfg->[0]});
+        @pp_args = values %{$cfg->[0]};
       }
       else {
-        DBIx::Class::Storage::Debug::PrettyPrint->new({ profile => $profile });
+        @pp_args = { profile => $profile };
+      }
+
+      # FIXME - FRAGILE
+      # Hash::Merge is a sorry piece of shit and tramples all over $@
+      # *without* throwing an exception
+      # This is a rather serious problem in the debug codepath
+      # Insulate the condition here with a try{} until a review of
+      # DBIx::Class::Storage::Debug::PrettyPrint takes place
+      # we do rethrow the error unconditionally, the only reason
+      # to try{} is to preserve the precise state of $@ (down
+      # to the scalar (if there is one) address level)
+      #
+      # Yes I am aware this is fragile and TxnScopeGuard needs
+      # a better fix. This is another yak to shave... :(
+      try {
+        DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args);
+      } catch {
+        $self->throw_exception($_);
       }
     }
     else {
@@ -695,11 +646,9 @@ Old name for DBIC_TRACE
 L<DBIx::Class::Storage::DBI> - reference storage implementation using
 SQL::Abstract and DBI.
 
-=head1 AUTHORS
-
-Matt S. Trout <mst@shadowcatsystems.co.uk>
+=head1 AUTHOR AND CONTRIBUTORS
 
-Andy Grundman <andy@hybridized.org>
+See L<AUTHOR|DBIx::Class/AUTHOR> and L<CONTRIBUTORS|DBIx::Class/CONTRIBUTORS> in DBIx::Class
 
 =head1 LICENSE