Avoid infinite loop if save point does not exist
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage.pm
index 9b7dbd9..f512843 100644 (file)
@@ -16,6 +16,7 @@ use DBIx::Class::Carp;
 use DBIx::Class::Storage::BlockRunner;
 use Scalar::Util qw/blessed weaken/;
 use DBIx::Class::Storage::TxnScopeGuard;
+use DBIx::Class::_Util 'dbic_internal_try';
 use Try::Tiny;
 use namespace::clean;
 
@@ -250,8 +251,19 @@ sub txn_rollback {
 
   if ($self->transaction_depth == 1) {
     $self->debugobj->txn_rollback() if $self->debug;
-    $self->_exec_txn_rollback;
     $self->{transaction_depth}--;
+
+    # in case things get really hairy - just disconnect
+    dbic_internal_try { $self->_exec_txn_rollback; 1 } or do {
+      my $rollback_error = $@;
+
+      # whatever happens, too low down the stack to care
+      # FIXME - revisit if stackable exceptions become a thing
+      dbic_internal_try { $self->disconnect };
+
+      die $rollback_error;
+    };
+
     $self->savepoints([]);
   }
   elsif ($self->transaction_depth > 1) {
@@ -281,7 +293,7 @@ sub __delicate_rollback {
   my $self = shift;
 
   if (
-    $self->transaction_depth > 1
+    ( $self->transaction_depth || 0 ) > 1
       and
     # FIXME - the autosvp check here shouldn't be happening, it should be a role-ish thing
     # The entire concept needs to be rethought with the storage layer... or something
@@ -299,16 +311,19 @@ sub __delicate_rollback {
     return;
   }
 
+  my @args = @_;
   my $rbe;
 
-  local $@; # taking no chances
-  unless( eval { $self->txn_rollback; 1 } ) {
+  dbic_internal_try {
+    $self->txn_rollback; 1
+  }
+  catch {
 
-    $rbe = $@;
+    $rbe = $_;
 
     # we were passed an existing exception to augment (think DESTROY stacks etc)
-    if (@_) {
-      my $exception = shift;
+    if (@args) {
+      my ($exception) = @args;
 
       # append our text - THIS IS A TEMPORARY FIXUP!
       #
@@ -356,7 +371,7 @@ sub __delicate_rollback {
         ) =~ s/Transaction aborted: (?=Transaction aborted:)//;
       }
     }
-  }
+  };
 
   return $rbe;
 }
@@ -416,12 +431,15 @@ sub svp_release {
 
   if (defined $name) {
     my @stack = @{ $self->savepoints };
-    my $svp;
+    my $svp = '';
 
-    do { $svp = pop @stack } until $svp eq $name;
+    while( $svp ne $name ) {
 
-    $self->throw_exception ("Savepoint '$name' does not exist")
-      unless $svp;
+      $self->throw_exception ("Savepoint '$name' does not exist")
+        unless @stack;
+
+      $svp = pop @stack;
+    }
 
     $self->savepoints(\@stack); # put back what's left
   }
@@ -561,9 +579,13 @@ sub debugobj {
       my @pp_args;
 
       if ($profile =~ /^\.?\//) {
-        require Config::Any;
 
-        my $cfg = try {
+        require DBIx::Class::Optional::Dependencies;
+        if ( my $missing = DBIx::Class::Optional::Dependencies->req_missing_for ('config_file_reader') ) {
+          $self->throw_exception("Unable to parse TRACE_PROFILE config file '$profile' without $missing");
+        }
+
+        my $cfg = dbic_internal_try {
           Config::Any->load_files({ files => [$profile], use_ext => 1 });
         } catch {
           # sanitize the error message a bit
@@ -589,7 +611,7 @@ sub debugobj {
       #
       # Yes I am aware this is fragile and TxnScopeGuard needs
       # a better fix. This is another yak to shave... :(
-      try {
+      dbic_internal_try {
         DBIx::Class::Storage::Debug::PrettyPrint->new(@pp_args);
       } catch {
         $self->throw_exception($_);