X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI.pm;h=0c388ed0546311ff7398add3bb017509d5da9366;hb=84efb6d7f74f92330bf03e923a5386bbf5e7cf7e;hp=af27c55fe348d07e20fd16bf714b4b197338f229;hpb=63af9ced21d59d5d92099a9b8853c2eece90569a;p=dbsrgits%2FDBIx-Class.git

diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm
index af27c55..0c388ed 100644
--- a/lib/DBIx/Class/Storage/DBI.pm
+++ b/lib/DBIx/Class/Storage/DBI.pm
@@ -13,7 +13,7 @@ use List::Util qw/first/;
 use Context::Preserve 'preserve_context';
 use Try::Tiny;
 use SQL::Abstract qw(is_plain_value is_literal_value);
-use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor);
+use DBIx::Class::_Util qw(quote_sub perlstring serialize detected_reinvoked_destructor scope_guard);
 use namespace::clean;
 
 # default cursor class, overridable in connect_info attributes
@@ -224,13 +224,17 @@ sub new {
   }
 
   END {
-    local $?; # just in case the DBI destructor changes it somehow
 
-    # destroy just the object if not native to this process
-    $_->_verify_pid for (grep
-      { defined $_ }
-      values %seek_and_destroy
-    );
+    if(
+      ! DBIx::Class::_ENV_::BROKEN_FORK
+        and
+      my @instances = grep { defined $_ } values %seek_and_destroy
+    ) {
+      local $?; # just in case the DBI destructor changes it somehow
+
+      # disarm the handle if not native to this process (see comment on top)
+      $_->_verify_pid for @instances;
+    }
   }
 
   sub CLONE {
@@ -242,9 +246,7 @@ sub new {
 
     for (@instances) {
       $_->_dbh(undef);
-
-      $_->transaction_depth(0);
-      $_->savepoints([]);
+      $_->disconnect;
 
       # properly renumber existing refs
       $_->_arm_global_destructor
@@ -256,9 +258,13 @@ sub DESTROY {
   return if &detected_reinvoked_destructor;
 
   $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
+
   # some databases spew warnings on implicit disconnect
+  return unless defined $_[0]->_dbh;
+
   local $SIG{__WARN__} = sub {};
   $_[0]->_dbh(undef);
+  # not calling ->disconnect here - we are being destroyed - nothing to reset
 
   # this op is necessary, since the very last perl runtime statement
   # triggers a global destruction shootout, and the $SIG localization
@@ -275,8 +281,7 @@ sub _verify_pid {
   if( defined $pid and $pid != $$ and my $dbh = $_[0]->_dbh ) {
     $dbh->{InactiveDestroy} = 1;
     $_[0]->_dbh(undef);
-    $_[0]->transaction_depth(0);
-    $_[0]->savepoints([]);
+    $_[0]->disconnect;
   }
 
   return;
@@ -870,20 +875,35 @@ database is not in C<AutoCommit> mode.
 =cut
 
 sub disconnect {
+  my $self = shift;
 
-  if( my $dbh = $_[0]->_dbh ) {
+  # this physical disconnect below might very well throw
+  # in order to unambiguously reset the state - do the cleanup in guard
 
-    $_[0]->_do_connection_actions(disconnect_call_ => $_) for (
-      ( $_[0]->on_disconnect_call || () ),
-      $_[0]->_parse_connect_do ('on_disconnect_do')
+  my $g = scope_guard {
+    $self->_dbh(undef);
+    $self->_dbh_details({});
+    $self->transaction_depth(undef);
+    $self->_dbh_autocommit(undef);
+    $self->savepoints([]);
+
+    # FIXME - this needs reenabling with the proper "no reset on same DSN" check
+    #$self->_sql_maker(undef); # this may also end up being different
+  };
+
+  if( my $dbh = $self->_dbh ) {
+
+    $self->_do_connection_actions(disconnect_call_ => $_) for (
+      ( $self->on_disconnect_call || () ),
+      $self->_parse_connect_do ('on_disconnect_do')
     );
 
     # stops the "implicit rollback on disconnect" warning
-    $_[0]->_exec_txn_rollback unless $_[0]->_dbh_autocommit;
+    $self->_exec_txn_rollback unless $self->_dbh_autocommit;
 
     %{ $dbh->{CachedKids} } = ();
+
     $dbh->disconnect;
-    $_[0]->_dbh(undef);
   }
 }
 
@@ -1038,12 +1058,9 @@ sub _init {}
 
 sub _populate_dbh {
 
-  $_[0]->_dbh(undef); # in case ->connected failed we might get sent here
-
-  $_[0]->_dbh_details({}); # reset everything we know
-
-  # FIXME - this needs reenabling with the proper "no reset on same DSN" check
-  #$_[0]->_sql_maker(undef); # this may also end up being different
+  # reset internal states
+  # also in case ->connected failed we might get sent here
+  $_[0]->disconnect;
 
   $_[0]->_dbh($_[0]->_connect);
 
@@ -1053,7 +1070,7 @@ sub _populate_dbh {
 
   # Always set the transaction depth on connect, since
   #  there is no transaction in progress by definition
-  $_[0]->{transaction_depth} = $_[0]->_dbh_autocommit ? 0 : 1;
+  $_[0]->transaction_depth( $_[0]->_dbh_autocommit ? 0 : 1 );
 
   $_[0]->_run_connection_actions unless $_[0]->{_in_determine_driver};
 
@@ -1405,6 +1422,7 @@ sub _do_connection_actions {
       # a handle in an undefined state in our storage object
       # kill it with fire and rethrow
       $self->_dbh(undef);
+      $self->disconnect;  # the $dbh is gone, but we still need to reset the rest
       $self->throw_exception( $_[0] );
     }
     else {
@@ -1618,7 +1636,9 @@ sub _exec_txn_commit {
 sub txn_rollback {
   my $self = shift;
 
-  $self->throw_exception("Unable to txn_rollback() on a disconnected storage")
+  # do a minimal connectivity check due to weird shit like
+  # https://rt.cpan.org/Public/Bug/Display.html?id=62370
+  $self->throw_exception("lost connection to storage")
     unless $self->_seems_connected;
 
   # esoteric case for folks using external $dbh handles