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
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');
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 {
}
$self->next::method(@_);
-
- if ($is_identity_insert) {
- $self->_unset_identity_insert ($source->name);
- }
}
sub insert {
my $updated_cols = $self->next::method(@_);
- if ($is_identity_insert) {
- $self->_unset_identity_insert ($source->name);
- }
-
return $updated_cols;
}
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);
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/
=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</connect_call_use_mars>
+
+=item * L</connect_call_use_dynamic_cursors>
+
+=item * L</connect_call_use_server_cursors>
+
+=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<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
+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
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;
}
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
B<WARNING>: 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<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
-for more information.
-
-B<WARNING>: 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<DBD::ODBC>.
=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;
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/};
$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") };
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
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/],
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" });
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/],
$schema = DBICTest::Schema->connect($dsn, $user, $pass, {
limit_dialect => $dialect,
+ %$opts,
$quoted
? ( quote_char => [ qw/ [ ] / ], name_sep => '.' )
: ()
});
# 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 {
is $rs->find($row->id)->amount, undef,'updated money value to NULL round-trip';
}
+}
+}
done_testing;
projects / dbsrgits/DBIx-Class.git / commitdiff