X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=f07adfdc7cf560d57aedc111711f311411fb7d1d;hb=514b84f6b60b566d75d2ff2ddd08659c4cf7b427;hp=5474e3654ce69a545c7d1e7fb33e311fc4056a51;hpb=fabbd5cca97aaef8e605a783c78abc1eaf9bdbae;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 5474e36..f07adfd 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -10,11 +10,11 @@ use base qw/ use mro 'c3'; use Try::Tiny; -use List::Util 'first'; +use DBIx::Class::_Util qw( dbic_internal_try sigwarn_silencer ); use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ - _identity _identity_method + _identity _identity_method _no_scope_identity_query /); __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL'); @@ -53,14 +53,14 @@ 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 # point we don't have many guarantees we will get what we expected. # http://msdn.microsoft.com/en-us/library/ms190315.aspx # http://davidhayden.com/blog/dave/archive/2006/01/17/2736.aspx - if ($self->_perform_autoinc_retrieval) { + if ($self->_perform_autoinc_retrieval and not $self->_no_scope_identity_query) { $sql .= "\nSELECT SCOPE_IDENTITY()"; } @@ -69,16 +69,21 @@ 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(@_); if ($self->_perform_autoinc_retrieval) { - # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked + # attempt to bring back the result of SELECT SCOPE_IDENTITY() we tacked # on in _prep_for_execute above - my ($identity) = try { $sth->fetchrow_array }; + my $identity; + + # we didn't even try on ftds + unless ($self->_no_scope_identity_query) { + ($identity) = dbic_internal_try { $sth->fetchrow_array }; + $sth->finish; + } # SCOPE_IDENTITY failed, but we can do something else if ( (! $identity) && $self->_identity_method) { @@ -88,7 +93,6 @@ sub _execute { } $self->_identity($identity); - $sth->finish; } return wantarray ? ($rv, $sth, @bind) : $rv; @@ -102,28 +106,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; } @@ -159,7 +161,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; }; @@ -173,13 +175,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 { + } + 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; }; } @@ -325,12 +346,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 and L. +=head1 FURTHER QUESTIONS? -=head1 LICENSE +Check the list of L. -You may distribute this code under the same terms as Perl itself. +=head1 COPYRIGHT AND LICENSE -=cut +This module is free software L +by the L. You can +redistribute it and/or modify it under the same terms as the +L.