Introduce GOVERNANCE document and empty RESOLUTIONS file.
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / MSSQL.pm
index fc505fa..9a49a42 100644 (file)
@@ -9,8 +9,7 @@ use base qw/
 /;
 use mro 'c3';
 
-use Try::Tiny;
-use List::Util 'first';
+use DBIx::Class::_Util qw( dbic_internal_try dbic_internal_catch sigwarn_silencer );
 use namespace::clean;
 
 __PACKAGE__->mk_group_accessors(simple => qw/
@@ -53,7 +52,7 @@ sub _prep_for_execute {
   my ($sql, $bind) = $self->next::method (@_);
 
   # SELECT SCOPE_IDENTITY only works within a statement scope. We
-  # must try to always use this particular idiom frist, as it is the
+  # must try to always use this particular idiom first, as it is the
   # only one that guarantees retrieving the correct id under high
   # concurrency. When this fails we will fall back to whatever secondary
   # retrieval method is specified in _identity_method, but at this
@@ -81,7 +80,7 @@ sub _execute {
 
     # we didn't even try on ftds
     unless ($self->_no_scope_identity_query) {
-      ($identity) = try { $sth->fetchrow_array };
+      ($identity) = dbic_internal_try { $sth->fetchrow_array };
       $sth->finish;
     }
 
@@ -161,7 +160,7 @@ sub sql_limit_dialect {
     # stored procedures like xp_msver, or version detection failed for some
     # other reason.
     # So, we use a query to check if RNO is implemented.
-    try {
+    dbic_internal_try {
       $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
       $supports_rno = 1;
     };
@@ -175,13 +174,32 @@ 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;
 
-  return try {
     $dbh->do('select 1');
     1;
-  } catch {
+  }
+  dbic_internal_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;
   };
 }
@@ -327,12 +345,13 @@ for this flag - you are urged to do so. If DBIC internals insist that an
 ordered subselect is necessary for an operation, and you believe there is a
 different/better way to get the same result - please file a bugreport.
 
-=head1 AUTHOR
-
-See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
+=head1 FURTHER QUESTIONS?
 
-=head1 LICENSE
+Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 
-You may distribute this code under the same terms as Perl itself.
+=head1 COPYRIGHT AND LICENSE
 
-=cut
+This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
+by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
+redistribute it and/or modify it under the same terms as the
+L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.