From: Peter Rabbitson <ribasushi@cpan.org>
Date: Fri, 1 Apr 2016 10:19:51 +0000 (+0200)
Subject: Fix annoying warnings on innocent looking MSSQL code
X-Git-Tag: v0.082840~22
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=commitdiff_plain;h=e8f23a7788c5e406dfd716b860b54112e6551c9f

Fix annoying warnings on innocent looking MSSQL code

( cherry-pick of d3a2e4249 )

After several rounds of improvements in the retry logic (84efb6d7, 729656c5)
MSSQL code non-fatally aborting due to clashing multiple active resultsets
would emit an annoying warning. Such warnings are especially baffling when
encountered in innocent-looking code like:

   my $first_bar_of_first_foo = $schema->resultset('Foo')
                                        ->search({ foo => 'fa' })
                                         ->next
                                          ->related_resultset("bar")
                                           ->next;

Since no object destruction takes place until the = operator is executed, the
cursor returning "first foo matching fa" is still active when we run a second
search for the "bars". With default MSSQL settings (i.e. without an enabled
MARS[1] implementation) this leads to an exception on the second ->next().
The failed next() is properly retried, since we are not in transaction or some
similar complicating factor, and the entire thing executes correctly, except
the force-disconnect-before-reconnect-after-failed-ping warns about the first
cursor being still alive.

Add extra stack marker for this particular case, and teach the MSSQL driver to
hide the (at this stage spurious) warning

[1] http://p3rl.org/DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server#MULTIPLE-ACTIVE-STATEMENTS
---

diff --git a/Changes b/Changes
index b6b1a1b..60ae978 100644
--- a/Changes
+++ b/Changes
@@ -6,6 +6,7 @@ Revision history for DBIx::Class
         - Fix use of ::Schema::Versioned combined with a user-supplied
           $dbh->{HandleError} (GH#101)
         - Fix parsing of DSNs containing driver arguments (GH#99)
+        - Fix spurious warning on MSSQL cursor invalidation retries (RT#102166)
         - Work around unreliable $sth->finish() on INSERT ... RETURNING within
           DBD::Firebird on some compiler/driver combinations (RT#110979)
         - Fix leaktest failures with upcoming version of Sub::Quote
diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm
index be29701..2862669 100644
--- a/lib/DBIx/Class/Storage/BlockRunner.pm
+++ b/lib/DBIx/Class/Storage/BlockRunner.pm
@@ -188,7 +188,12 @@ sub _run {
           # FIXME - we assume that $storage->{_dbh_autocommit} is there if
           # txn_init_depth is there, but this is a DBI-ism
           $txn_init_depth > ( $storage->{_dbh_autocommit} ? 0 : 1 )
-        ) or ! $self->retry_handler->($self)
+        )
+          or
+        ! do {
+          local $self->storage->{_in_do_block_retry_handler} = 1;
+          $self->retry_handler->($self)
+        }
       );
 
       # we got that far - let's retry
diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index 5b4c422..90c05f8 100644
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -10,6 +10,7 @@ use base qw/
 use mro 'c3';
 
 use Try::Tiny;
+use DBIx::Class::_Util qw( sigwarn_silencer );
 use List::Util 'first';
 use namespace::clean;
 
@@ -175,13 +176,31 @@ sub _ping {
 
   my $dbh = $self->_dbh or return 0;
 
-  local $dbh->{RaiseError} = 1;
-  local $dbh->{PrintError} = 0;
-
-  return try {
+  try {
+    local $dbh->{RaiseError} = 1;
+    local $dbh->{PrintError} = 0;
     $dbh->do('select 1');
     1;
-  } catch {
+  }
+  catch {
+    # MSSQL is *really* annoying wrt multiple active resultsets,
+    # and this may very well be the reason why the _ping failed
+    #
+    # Proactively disconnect, while hiding annoying warnings if the case
+    #
+    # The callchain is:
+    #   < check basic retryability prerequisites (e.g. no txn) >
+    #    ->retry_handler
+    #     ->storage->connected()
+    #      ->ping
+    # So if we got here with the in_handler bit set - we won't  break
+    # anything by a disconnect
+    if( $self->{_in_do_block_retry_handler} ) {
+      local $SIG{__WARN__} = sigwarn_silencer qr/disconnect invalidates .+? active statement/;
+      $self->disconnect;
+    }
+
+    # RV of _ping itself
     0;
   };
 }
diff --git a/t/746mssql.t b/t/746mssql.t
index e4a9de0..e2c3abd 100644
--- a/t/746mssql.t
+++ b/t/746mssql.t
@@ -3,6 +3,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use Try::Tiny;
 
 use DBIx::Class::Optional::Dependencies ();
@@ -102,11 +103,35 @@ SQL
 
     ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name");
 
-# Test multiple active statements
-    SKIP: {
-      skip 'not a multiple active statements configuration', 1
-        if $opts_name eq 'plain';
+# Test graceful error handling if not supporting multiple active statements
+    if( $opts_name eq 'plain' ) {
+
+      # keep the first cursor alive (as long as $rs is alive)
+      my $rs = $schema->resultset("Artist");
+
+      my $a1 = $rs->next;
+
+      my $a2;
+
+      warnings_are {
+        # second cursor, invalidates $rs, but it doesn't
+        # matter as long as we do not try to use it
+        $a2 = $schema->resultset("Artist")->next;
+      } [], 'No warning on retry due to previous cursor invalidation';
 
+      is_deeply(
+        { $a1->get_columns },
+        { $a2->get_columns },
+        'Same data',
+      );
+
+      dies_ok {
+        $rs->next;
+      } 'Invalid cursor did not silently return garbage';
+    }
+
+# Test multiple active statements
+    else {
       $schema->storage->ensure_connected;
 
       lives_ok {