X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage.pm;h=049230af6419f049c322af64ee6916d635181553;hb=79346e56a9ebf94b504a2ee19e96ff3547a77321;hp=a3ae53277a48ace14aac7850ba3454c5a193fa09;hpb=9345b14c6c86aa8888bf5d47a569ee9bbde24f47;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage.pm b/lib/DBIx/Class/Storage.pm
index a3ae532..049230a 100644
--- a/lib/DBIx/Class/Storage.pm
+++ b/lib/DBIx/Class/Storage.pm
@@ -175,15 +175,16 @@ transaction failure.
 
 sub txn_do {
   my $self = shift;
-  my $coderef = shift;
 
   DBIx::Class::Storage::BlockRunner->new(
     storage => $self,
-    run_code => $coderef,
-    run_args => \@_, # take a ref instead of a copy, to preserve coderef @_ aliasing semantics
     wrap_txn => 1,
-    retry_handler => sub { ! ( $_[0]->retried_count or $_[0]->storage->connected ) },
-  )->run;
+    retry_handler => sub {
+      $_[0]->failed_attempt_count == 1
+        and
+      ! $_[0]->storage->connected
+    },
+  )->run(@_);
 }
 
 =head2 txn_begin
@@ -226,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}--;
@@ -251,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}--;
@@ -395,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;
 
@@ -433,10 +436,10 @@ 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
-set to be STDERR - although see information on the
-L<DBIC_TRACE> environment variable.
+An opportunistic proxy to L<< ->debugobj->debugfh(@_)
+|DBIx::Class::Storage::Statistics/debugfh >>
+If the currently set L</debugobj> does not have a L</debugfh> method, caling
+this is a no-op.
 
 =cut
 
@@ -467,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;
 
@@ -478,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 {
@@ -613,7 +636,6 @@ filename the file is read with L<Config::Any> and the results are
 used as the configuration for tracing.  See L<SQL::Abstract::Tree/new>
 for what that structure should look like.
 
-
 =head2 DBIX_CLASS_STORAGE_DBI_DEBUG
 
 Old name for DBIC_TRACE
@@ -623,15 +645,16 @@ 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 FURTHER QUESTIONS?
 
-Andy Grundman <andy@hybridized.org>
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-=head1 LICENSE
+=head1 COPYRIGHT AND LICENSE
 
-You may distribute this code under the same terms as Perl itself.
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 
 =cut