From: Rafael Kitover Date: Tue, 4 Jan 2011 12:06:53 +0000 (-0500) Subject: Improvements for MSSQL+ODBC multiple active resultset options X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=384b8bce2;p=dbsrgits%2FDBIx-Class-Historic.git Improvements for MSSQL+ODBC multiple active resultset options --- diff --git a/Changes b/Changes index be237c0..95e8ee0 100644 --- a/Changes +++ b/Changes @@ -16,6 +16,8 @@ Revision history for DBIx::Class Previously (starting with 0.08124) an exception was thrown * Fixes + - A number of improvements/diagnostics of multiple active resultset + handling on MSSQL over DBD::ODBC - Revert default selection to being lazy again (eagerness introduced in 0.08125) - fixes DBIx::Class::Helper::ResultSet::RemoveColumns - Fix losing order of columns provided in select/as (regression from diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 1a1f355..d16d318 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -10,7 +10,7 @@ use List::Util 'first'; use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ - _identity _identity_method + _identity _identity_method _pre_insert_sql _post_insert_sql /); __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL'); @@ -18,31 +18,11 @@ __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL'); sub _set_identity_insert { my ($self, $table) = @_; - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s ON', - $self->sql_maker->_quote ($table), - ); + my $stmt = 'SET IDENTITY_INSERT %s %s'; + $table = $self->sql_maker->_quote($table); - my $dbh = $self->_get_dbh; - try { $dbh->do ($sql) } - catch { - $self->throw_exception (sprintf "Error executing '%s': %s", - $sql, - $dbh->errstr, - ); - }; -} - -sub _unset_identity_insert { - my ($self, $table) = @_; - - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s OFF', - $self->sql_maker->_quote ($table), - ); - - my $dbh = $self->_get_dbh; - $dbh->do ($sql); + $self->_pre_insert_sql (sprintf $stmt, $table, 'ON'); + $self->_post_insert_sql(sprintf $stmt, $table, 'OFF'); } sub insert_bulk { @@ -60,10 +40,6 @@ sub insert_bulk { } $self->next::method(@_); - - if ($is_identity_insert) { - $self->_unset_identity_insert ($source->name); - } } sub insert { @@ -81,10 +57,6 @@ sub insert { my $updated_cols = $self->next::method(@_); - if ($is_identity_insert) { - $self->_unset_identity_insert ($source->name); - } - return $updated_cols; } @@ -114,8 +86,15 @@ sub _prep_for_execute { my ($sql, $bind) = $self->next::method (@_); if ($op eq 'insert') { - $sql .= ';SELECT SCOPE_IDENTITY()'; - + if (my $prepend = $self->_pre_insert_sql) { + $sql = "${prepend}\n${sql}"; + $self->_pre_insert_sql(undef); + } + if (my $append = $self->_post_insert_sql) { + $sql = "${sql}\n${append}"; + $self->_post_insert_sql(undef); + } + $sql .= "\nSELECT SCOPE_IDENTITY()"; } return ($sql, $bind); diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index b2db13f..03053c6 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -6,6 +6,7 @@ use base qw/DBIx::Class::Storage::DBI::MSSQL/; use mro 'c3'; use Scalar::Util 'reftype'; use Try::Tiny; +use Carp::Clan qw/^DBIx::Class/; use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ @@ -29,7 +30,75 @@ L. =head1 MULTIPLE ACTIVE STATEMENTS The following options are alternative ways to enable concurrent executing -statement support. Each has its own advantages and drawbacks. +statement support. Each has its own advantages and drawbacks and works on +different platforms. Read each section carefully. + +In order of preference, they are: + +=over 8 + +=item * L + +=item * L + +=item * L + +=back + +=head1 METHODS + +=head2 connect_call_use_mars + +Use as: + + on_connect_call => 'use_mars' + +Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result +Sets". See L +for more information. + +This does not work on FreeTDS drivers at the time of this writing, and only +works with the Native Client, later versions of the Windows MS ODBC driver, and +the Easysoft driver. + +=cut + +sub connect_call_use_mars { + my $self = shift; + + my $dsn = $self->_dbi_connect_info->[0]; + + if (ref($dsn) eq 'CODE') { + $self->throw_exception('cannot change the DBI DSN on a CODE ref connect_info'); + } + + if ($dsn !~ /MARS_Connection=/) { + if ($self->using_freetds) { + $self->throw_exception('FreeTDS does not support MARS at the time of ' + .'writing.'); + } + + if (exists $self->_server_info->{normalized_dbms_version} && + $self->_server_info->{normalized_dbms_version} < 9) { + $self->throw_exception('SQL Server 2005 or later required to use MARS.'); + } + + if (my ($data_source) = $dsn =~ /^dbi:ODBC:([\w-]+)\z/i) { # prefix with DSN + warn "Bare DSN in ODBC connect string, rewriting to DSN=$data_source\n"; + $dsn = "dbi:ODBC:DSN=$data_source"; + } + + $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes"; + $self->disconnect; + $self->ensure_connected; + } +} + +sub connect_call_use_MARS { + carp "'connect_call_use_MARS' has been deprecated, use " + ."'connect_call_use_mars' instead."; + shift->connect_call_use_mars(@_) +} =head2 connect_call_use_dynamic_cursors @@ -66,7 +135,7 @@ sub connect_call_use_dynamic_cursors { my $dbi_attrs = $self->_dbi_connect_info->[-1]; - unless (ref($dbi_attrs) && reftype $dbi_attrs eq 'HASH') { + unless (ref $dbi_attrs eq 'HASH') { $dbi_attrs = {}; push @{ $self->_dbi_connect_info }, $dbi_attrs; } @@ -103,20 +172,18 @@ EOF sub _init { my $self = shift; - no warnings qw/uninitialized/; - if ( ref($self->_dbi_connect_info->[0]) ne 'CODE' && ref ($self->_dbi_connect_info->[-1]) eq 'HASH' && - $self->_dbi_connect_info->[-1]{odbc_cursortype} == 2 + ($self->_dbi_connect_info->[-1]{odbc_cursortype} || 0) > 1 ) { $self->_set_dynamic_cursors; - return; } - - $self->_using_dynamic_cursors(0); + else { + $self->_using_dynamic_cursors(0); + } } =head2 connect_call_use_server_cursors @@ -134,44 +201,43 @@ C<2>. B: this does not work on all versions of SQL Server, and may lock up your database! +At the time of writing, this option only works on Microsoft's Windows drivers, +later versions of the ODBC driver and the Native Client driver. + =cut sub connect_call_use_server_cursors { my $self = shift; my $sql_rowset_size = shift || 2; + if ($^O !~ /win32|cygwin/i) { + $self->throw_exception('Server cursors only work on Windows platforms at ' + .'the time of writing.'); + } + $self->_get_dbh->{odbc_SQL_ROWSET_SIZE} = $sql_rowset_size; } -=head2 connect_call_use_MARS - -Use as: +=head2 using_freetds - on_connect_call => 'use_MARS' - -Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result -Sets". See L -for more information. - -B: This has implications for the way transactions are handled. +Tries to determine, to the best of our ability, whether or not you are using the +FreeTDS driver with L. =cut -sub connect_call_use_MARS { +sub using_freetds { my $self = shift; my $dsn = $self->_dbi_connect_info->[0]; - if (ref($dsn) eq 'CODE') { - $self->throw_exception('cannot change the DBI DSN on a CODE ref connect_info'); - } + $dsn = '' if ref $dsn eq 'CODE'; - if ($dsn !~ /MARS_Connection=/) { - $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes"; - my $was_connected = defined $self->_dbh; - $self->disconnect; - $self->ensure_connected if $was_connected; - } + my $dbh = $self->_get_dbh; + + return 1 if $dsn =~ /driver=FreeTDS/i + || (try { $dbh->get_info(6) }||'') =~ /tdsodbc/i; + + return 0; } 1; diff --git a/t/746mssql.t b/t/746mssql.t index ba8d1b8..a822aec 100644 --- a/t/746mssql.t +++ b/t/746mssql.t @@ -6,6 +6,7 @@ use Test::Exception; use lib qw(t/lib); use DBICTest; use DBIC::SqlMakerTest; +use Try::Tiny; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_MSSQL_ODBC_${_}" } qw/DSN USER PASS/}; @@ -44,6 +45,29 @@ lives_ok { $schema->storage->dbh_do(sub { $_[1]->do('select 1') }) } '_ping works'; +my %opts = ( + use_mars => + { on_connect_call => 'use_mars' }, + use_dynamic_cursors => + { on_connect_call => 'use_dynamic_cursors' }, + use_server_cursors => + { on_connect_call => 'use_server_cursors' }, + plain => + {}, +); + +for my $opts_name (keys %opts) { + SKIP: { + my $opts = $opts{$opts_name}; + $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); + + try { + $schema->storage->ensure_connected + } + catch { + skip "$opts_name not functional in this configuration: $_", 1; + }; + $schema->storage->dbh_do (sub { my ($storage, $dbh) = @_; eval { $dbh->do("DROP TABLE artist") }; @@ -58,35 +82,43 @@ CREATE TABLE artist ( SQL }); -my %seen_id; +# test Auto-PK + $schema->resultset('Artist')->search({ name => 'foo' })->delete; -my @opts = ( - { on_connect_call => 'use_dynamic_cursors' }, - {}, -); -# test Auto-PK with different options -for my $opts (@opts) { - SKIP: { - $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); + my $new = $schema->resultset('Artist')->create({ name => 'foo' }); - eval { - $schema->storage->ensure_connected - }; - if ($@ =~ /dynamic cursors/) { - skip -'Dynamic Cursors not functional, tds_version 8.0 or greater required if using'. -' FreeTDS', 1; - } + ok(($new->artistid||0) > 0, "Auto-PK worked for $opts_name"); - $schema->resultset('Artist')->search({ name => 'foo' })->delete; +# Test multiple active statements + SKIP: { + skip 'not a multiple active statements configuration', 1 + if $opts_name eq 'plain'; - my $new = $schema->resultset('Artist')->create({ name => 'foo' }); + my $artist_rs = $schema->resultset('Artist'); - ok($new->artistid > 0, "Auto-PK worked"); - } -} + $artist_rs->delete; + $artist_rs->create({ name => "Artist$_" }) for (1..3); + my $forward = $artist_rs->search({}, + { order_by => { -asc => 'artistid' } }); + my $backward = $artist_rs->search({}, + { order_by => { -desc => 'artistid' } }); + + my @map = ( + [qw/Artist1 Artist3/], [qw/Artist2 Artist2/], [qw/Artist3 Artist1/] + ); + my @result; + + while (my $forward_row = $forward->next) { + my $backward_row = $backward->next; + push @result, [$forward_row->name, $backward_row->name]; + } + + is_deeply \@result, \@map, "multiple active statements in $opts_name"; + + $artist_rs->delete; + } # Test populate @@ -114,7 +146,7 @@ SQL lives_ok ( sub { # start a new connection, make sure rebless works - my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); $schema->populate ('Owners', [ [qw/id name /], [qw/1 wiggle/], @@ -139,7 +171,7 @@ SQL lives_ok (sub { # start a new connection, make sure rebless works # test an insert with a supplied identity, followed by one without - my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); for (2, 1) { my $id = $_ * 20 ; $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" }); @@ -151,7 +183,7 @@ SQL lives_ok ( sub { # start a new connection, make sure rebless works - my $schema = DBICTest::Schema->connect($dsn, $user, $pass); + my $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); $schema->populate ('BooksInLibrary', [ [qw/source owner title /], [qw/Library 1 secrets0/], @@ -183,6 +215,7 @@ for my $dialect ( $schema = DBICTest::Schema->connect($dsn, $user, $pass, { limit_dialect => $dialect, + %$opts, $quoted ? ( quote_char => [ qw/ [ ] / ], name_sep => '.' ) : () @@ -421,7 +454,7 @@ SQL }); # start disconnected to make sure insert works on an un-reblessed storage - $schema = DBICTest::Schema->connect($dsn, $user, $pass); + $schema = DBICTest::Schema->connect($dsn, $user, $pass, $opts); my $row; lives_ok { @@ -485,6 +518,8 @@ SQL is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip'; } +} +} done_testing;