Introduce GOVERNANCE document and empty RESOLUTIONS file.

[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / MSSQL.pm

diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
index b20db9f..9a49a42 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm
+++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm
@@ -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
@@ -69,7 +68,6 @@ sub _prep_for_execute {
 
 sub _execute {
   my $self = shift;
-  my ($op) = @_;
 
   # always list ctx - we need the $sth
   my ($rv, $sth, @bind) = $self->next::method(@_);
@@ -82,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;
     }
 
@@ -107,28 +105,26 @@ sub last_insert_id { shift->_identity }
 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
 #
 sub _select_args_to_query {
+  #my ($self, $ident, $select, $cond, $attrs) = @_;
   my $self = shift;
+  my $attrs = $_[3];
 
-  my ($sql, $prep_bind, @rest) = $self->next::method (@_);
+  my $sql_bind = $self->next::method (@_);
 
   # see if this is an ordered subquery
-  my $attrs = $_[3];
   if (
-    $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
-      &&
+    $$sql_bind->[0] !~ /^ \s* \( \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
+      and
     scalar $self->_extract_order_criteria ($attrs->{order_by})
   ) {
     $self->throw_exception(
-      'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
-    ') unless $attrs->{unsafe_subselect_ok};
-    my $max = $self->sql_maker->__max_int;
-    $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
+      'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL'
+    ) unless $attrs->{unsafe_subselect_ok};
+
+    $$sql_bind->[0] =~ s/^ \s* \( \s* SELECT (?=\s) / '(SELECT TOP ' . $self->sql_maker->__max_int /exi;
   }
 
-  return wantarray
-    ? ($sql, $prep_bind, @rest)
-    : \[ "($sql)", @$prep_bind ]
-  ;
+  $sql_bind;
 }
 
 
@@ -164,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;
     };
@@ -178,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;
   };
 }
@@ -330,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>.