Fix annoying warnings on innocent looking MSSQL code

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 7b2a01d..5aa2ea5 100644 (file)
--- a/Changes
+++ b/Changes
@@ -49,6 +49,7 @@ Revision history for DBIx::Class
         - Fix spurious ROLLBACK statements when a TxnScopeGuard fails a commit
           of a transaction with deferred FK checks: a guard is now inactivated
           immediately before the commit is attempted (RT#107159)
+        - 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)
         - Really fix savepoint rollbacks on older DBD::SQLite (fix in 0.082800

diff --git a/lib/DBIx/Class/Storage/BlockRunner.pm b/lib/DBIx/Class/Storage/BlockRunner.pm
index 0f884da..9b5bdbc 100644 (file)
--- a/lib/DBIx/Class/Storage/BlockRunner.pm
+++ b/lib/DBIx/Class/Storage/BlockRunner.pm
@@ -187,7 +187,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 4eb090a..aed3689 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -9,7 +9,8 @@ use base qw/
 /;
 use mro 'c3';
 
-use DBIx::Class::_Util 'dbic_internal_try';
+use Try::Tiny;
+use DBIx::Class::_Util qw( dbic_internal_try sigwarn_silencer );
 use List::Util 'first';
 use namespace::clean;
 
@@ -175,16 +176,34 @@ sub _ping {
 
   my $dbh = $self->_dbh or return 0;
 
-  local $dbh->{RaiseError} = 1;
-  local $dbh->{PrintError} = 0;
+  dbic_internal_try {
+    local $dbh->{RaiseError} = 1;
+    local $dbh->{PrintError} = 0;
 
-  (dbic_internal_try {
     $dbh->do('select 1');
     1;
-  })
-    ? 1
-    : 0
-  ;
+  }
+  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;
+  };
 }
 
 package # hide from PAUSE

diff --git a/t/746mssql.t b/t/746mssql.t
index c7753c7..d1b8773 100644 (file)
--- a/t/746mssql.t
+++ b/t/746mssql.t
@@ -6,6 +6,7 @@ use warnings;
 
 use Test::More;
 use Test::Exception;
+use Test::Warn;
 use Try::Tiny;
 
 
@@ -98,11 +99,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 {