[Bast-commits] r7586 - in DBIx-Class/0.08/trunk:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI t
ribasushi at dev.catalyst.perl.org
ribasushi at dev.catalyst.perl.org
Sun Sep 6 18:35:30 GMT 2009
Author: ribasushi
Date: 2009-09-06 18:35:30 +0000 (Sun, 06 Sep 2009)
New Revision: 7586
Modified:
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
DBIx-Class/0.08/trunk/t/746mssql.t
Log:
Centralize identity insert control for mssql (it seems that issuing an OFF is not necessary)
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-06 16:33:46 UTC (rev 7585)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI/MSSQL.pm 2009-09-06 18:35:30 UTC (rev 7586)
@@ -14,31 +14,26 @@
__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
+sub _set_identity_insert {
+ my ($self, $table) = @_;
+ $self->_get_dbh->do (sprintf
+ 'SET IDENTITY_INSERT %s ON',
+ $self->sql_maker->_quote ($table)
+ );
+}
+
sub insert_bulk {
my $self = shift;
my ($source, $cols, $data) = @_;
- my $identity_insert = 0;
-
- COLUMNS:
- foreach my $col (@{$cols}) {
- if ($source->column_info($col)->{is_auto_increment}) {
- $identity_insert = 1;
- last COLUMNS;
- }
+ if (List::Util::first
+ { $source->column_info ($_)->{is_auto_increment} }
+ (@{$cols})
+ ) {
+ $self->_set_identity_insert ($source->name);
}
- if ($identity_insert) {
- my $table = $source->from;
- $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
- }
-
$self->next::method(@_);
-
- if ($identity_insert) {
- my $table = $source->from;
- $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
- }
}
# support MSSQL GUID column types
@@ -47,7 +42,7 @@
my $self = shift;
my ($source, $to_insert) = @_;
- my $updated_cols = {};
+ my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
my %guid_cols;
my @pk_cols = $source->primary_columns;
@@ -71,11 +66,17 @@
my @get_guids_for =
grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
+ my $updated_cols = {};
+
for my $guid_col (@get_guids_for) {
my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
$updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
}
+ if (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) {
+ $self->_set_identity_insert ($source->name);
+ }
+
$updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
return $updated_cols;
@@ -105,14 +106,6 @@
if ($op eq 'insert') {
$sql .= ';SELECT SCOPE_IDENTITY()';
- my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
- if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
-
- my $table = $ident->from;
- my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
- my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
- $sql = "$identity_insert_on; $sql; $identity_insert_off";
- }
}
return ($sql, $bind);
Modified: DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-09-06 16:33:46 UTC (rev 7585)
+++ DBIx-Class/0.08/trunk/lib/DBIx/Class/Storage/DBI.pm 2009-09-06 18:35:30 UTC (rev 7586)
@@ -1359,6 +1359,7 @@
local $Data::Dumper::Indent = 1;
local $Data::Dumper::Useqq = 1;
local $Data::Dumper::Quotekeys = 0;
+ local $Data::Dumper::Sortkeys = 1;
$self->throw_exception(sprintf "%s for populate slice:\n%s",
$tuple_status->[$i][1],
Modified: DBIx-Class/0.08/trunk/t/746mssql.t
===================================================================
--- DBIx-Class/0.08/trunk/t/746mssql.t 2009-09-06 16:33:46 UTC (rev 7585)
+++ DBIx-Class/0.08/trunk/t/746mssql.t 2009-09-06 18:35:30 UTC (rev 7586)
@@ -12,8 +12,6 @@
plan skip_all => 'Set $ENV{DBICTEST_MSSQL_ODBC_DSN}, _USER and _PASS to run this test'
unless ($dsn && $user);
-plan tests => 39;
-
DBICTest::Schema->load_classes('ArtistGUID');
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -220,6 +218,19 @@
]);
}, 'populate with PKs supplied ok' );
+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);
+ for (1..2) {
+ my $id = $_ * 20 ;
+ $schema->resultset ('Owners')->create ({ id => $id, name => "troglodoogle $id" });
+ $schema->resultset ('Owners')->create ({ name => "troglodoogle " . ($id + 1) });
+ }
+}, 'create with/without PKs ok' );
+
+is ($schema->resultset ('Owners')->count, 19, 'owner rows really in db' );
+
lives_ok ( sub {
# start a new connection, make sure rebless works
my $schema = DBICTest::Schema->connect($dsn, $user, $pass);
@@ -329,9 +340,10 @@
],
);
}
-
}
+done_testing;
+
# clean up our mess
END {
if (my $dbh = eval { $schema->storage->_dbh }) {
More information about the Bast-commits
mailing list