Ensure the $storage state reflects the current connection state closely

Add several extra calls to ->disconnect, ensuring that oddball events do not
leave things in an undefined state. Even more rather hideous testcases, looks
like that problem has been nailed now. Several remain, see next commits :(

Changes

@@ -22,6 +22,8 @@ Revision history for DBIx::Class
           notably on_connect* failures now properly abort the entire connect
         - Fix incorrect SQL generated with invalid {rows} on complex resultset
           operations, generally more robust handling of rows/offset attrs
+        - Fix incorrect $storage state on unexpected RDBMS disconnects and
+          other failure events, preventing clean reconnection (RT#110429)
         - Make sure exception objects stringifying to '' are properly handled
           and warned about (GH#15)
         - Fix corner case of stringify-only overloaded objects being used in

lib/DBIx/Class/Storage.pm

@@ -250,8 +250,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
+    eval { $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
+      eval { $self->disconnect };
+
+      die $rollback_error;
+    };
+
     $self->savepoints([]);
   }
   elsif ($self->transaction_depth > 1) {
@@ -281,7 +292,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

lib/DBIx/Class/Storage/BlockRunner.pm

@@ -136,9 +136,14 @@ sub _run {
     my @res = @_;
 
     my $storage = $self->storage;
-    my $cur_depth = $storage->transaction_depth;
 
-    if (defined $txn_init_depth and ! is_exception $run_err) {
+    if (
+      defined $txn_init_depth
+        and
+      ! is_exception $run_err
+        and
+      defined( my $cur_depth = $storage->transaction_depth )
+    ) {
       my $delta_txn = (1 + $txn_init_depth) - $cur_depth;
 
       if ($delta_txn) {

lib/DBIx/Class/Storage/DBI.pm

@@ -956,7 +956,15 @@ sub connected {
 sub _seems_connected {
   $_[0]->_verify_pid unless DBIx::Class::_ENV_::BROKEN_FORK;
 
-  ($_[0]->_dbh || return 0)->FETCH('Active');
+  $_[0]->_dbh
+    and
+  $_[0]->_dbh->FETCH('Active')
+    and
+  return 1;
+
+  # explicitly reset all state
+  $_[0]->disconnect;
+  return 0;
 }
 
 sub _ping {

t/71mysql.t

@@ -7,9 +7,9 @@ use Test::More;
 use Test::Exception;
 use Test::Warn;
 
+use B::Deparse;
 use DBI::Const::GetInfoType;
 use Scalar::Util qw/weaken/;
-use DBIx::Class::Optional::Dependencies ();
 
 use lib qw(t/lib);
 use DBICTest;
@@ -452,4 +452,56 @@ ZEROINSEARCH: {
   ok ($rs->find({ name => "Hardcore Forker $pid" }), 'Expected row created');
 }
 
+# Ensure disappearing RDBMS does not leave the storage in an inconsistent state
+# Unlike the test in storage/reconnect.t we test live RDBMS-side disconnection
+for my $cref (
+  sub {
+    my $schema = shift;
+
+    my $g = $schema->txn_scope_guard;
+
+    is( $schema->storage->transaction_depth, 1, "Expected txn depth" );
+
+    $schema->storage->_dbh->do("SELECT SLEEP(2)");
+  },
+  sub {
+    my $schema = shift;
+    $schema->txn_do(sub {
+      is( $schema->storage->transaction_depth, 1, "Expected txn depth" );
+      $schema->storage->_dbh->do("SELECT SLEEP(2)")
+    } );
+  },
+  sub {
+    my $schema = shift;
+
+    my $g = $schema->txn_scope_guard;
+
+    $schema->txn_do(sub {
+      is( $schema->storage->transaction_depth, 2, "Expected txn depth" );
+      $schema->storage->_dbh->do("SELECT SLEEP(2)")
+    } );
+  },
+) {
+
+  note( "Testing with " . B::Deparse->new->coderef2text($cref) );
+
+  my $schema = DBICTest::Schema->connect($dsn, $user, $pass, {
+    mysql_read_timeout => 1,
+  });
+
+  ok( !$schema->storage->connected, 'Not connected' );
+
+  is( $schema->storage->transaction_depth, undef, "Start with unknown txn depth" );
+
+  throws_ok {
+    $cref->($schema)
+  } qr/Rollback failed/;
+
+  ok( !$schema->storage->connected, 'Not connected as a result of failed rollback' );
+
+  is( $schema->storage->transaction_depth, undef, "Depth expectedly unknown after failed rollbacks" );
+
+  ok( $schema->resultset('Artist')->count, 'query works after the fact' );
+}
+
 done_testing;

t/storage/reconnect.t

@@ -2,7 +2,9 @@ use strict;
 use warnings;
 
 use FindBin;
+use B::Deparse;
 use File::Copy 'move';
+use Scalar::Util 'weaken';
 use Test::More;
 use Test::Exception;
 use lib qw(t/lib);
@@ -106,4 +108,65 @@ for my $ctx (keys %$ctx_map) {
   }
 };
 
+# make sure RT#110429 does not recur on manual DBI-side disconnect
+for my $cref (
+  sub {
+    my $schema = shift;
+
+    my $g = $schema->txn_scope_guard;
+
+    is( $schema->storage->transaction_depth, 1, "Expected txn depth" );
+
+    $schema->storage->_dbh->disconnect;
+
+    $schema->storage->dbh_do(sub { $_[1]->do('SELECT 1') } );
+  },
+  sub {
+    my $schema = shift;
+    $schema->txn_do(sub {
+      $schema->storage->_dbh->disconnect
+    } );
+  },
+  sub {
+    my $schema = shift;
+    $schema->txn_do(sub {
+      $schema->storage->disconnect;
+      die "VIOLENCE";
+    } );
+  },
+) {
+
+  note( "Testing with " . B::Deparse->new->coderef2text($cref) );
+
+  $schema->storage->disconnect;
+
+  ok( !$schema->storage->connected, 'Not connected' );
+
+  is( $schema->storage->transaction_depth, undef, "Start with unknown txn depth" );
+
+  # messages vary depending on version and whether txn or do, whatever
+  dies_ok {
+    $cref->($schema)
+  } 'Threw *something*';
+
+  ok( !$schema->storage->connected, 'Not connected as a result of failed rollback' );
+
+  is( $schema->storage->transaction_depth, undef, "Depth expectedly unknown after failed rollbacks" );
+}
+
+# check that things aren't crazy with a non-violent disconnect
+{
+  my $schema = DBICTest->init_schema( sqlite_use_file => 0, no_deploy => 1 );
+  weaken( my $ws = $schema );
+
+  $schema->is_executed_sql_bind( sub {
+    $ws->txn_do(sub { $ws->storage->disconnect } );
+  }, [ [ 'BEGIN' ] ], 'Only one BEGIN statement' );
+
+  $schema->is_executed_sql_bind( sub {
+    my $g = $ws->txn_scope_guard;
+    $ws->storage->disconnect;
+  }, [ [ 'BEGIN' ] ], 'Only one BEGIN statement' );
+}
+
 done_testing;