X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=28b87f2ed6755699c81a74f8186d8a1236a14af7;hb=6553ac3837081c481ecdf269c7aff407c348a807;hp=8bcb8cb18493a9b907b56dc1e65b9e6bd2fda0fd;hpb=fd05d10a0f2840dfe35e10ad848a62bcc5e816fb;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 8bcb8cb..28b87f2 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -14,30 +14,55 @@ __PACKAGE__->mk_group_accessors(simple => qw/ __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL'); +sub _set_identity_insert { + my ($self, $table) = @_; + + my $sql = sprintf ( + 'SET IDENTITY_INSERT %s ON', + $self->sql_maker->_quote ($table), + ); + + my $dbh = $self->_get_dbh; + eval { $dbh->do ($sql) }; + if ($@) { + $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); +} + 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; - } - } + my $is_identity_insert = (List::Util::first + { $source->column_info ($_)->{is_auto_increment} } + (@{$cols}) + ) + ? 1 + : 0; - if ($identity_insert) { - my $table = $source->from; - $self->_get_dbh->do("SET IDENTITY_INSERT $table ON"); + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); } $self->next::method(@_); - if ($identity_insert) { - my $table = $source->from; - $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF"); + if ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); } } @@ -47,7 +72,7 @@ sub insert { 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,13 +96,28 @@ sub insert { 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; } + my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) + ? 1 + : 0; + + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); + } + $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } }; + if ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); + } + + return $updated_cols; } @@ -105,14 +145,6 @@ sub _prep_for_execute { 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); @@ -128,7 +160,7 @@ sub _execute { # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked # on in _prep_for_execute above - my ($identity) = $sth->fetchrow_array; + my ($identity) = eval { $sth->fetchrow_array }; # SCOPE_IDENTITY failed, but we can do something else if ( (! $identity) && $self->_identity_method) { @@ -146,6 +178,41 @@ sub _execute { sub last_insert_id { shift->_identity } +# +# MSSQL is retarded wrt ordered subselects. One needs to add a TOP 100% +# to *all* subqueries, do it here. +# +sub _select_args_to_query { + my $self = shift; + + # _select_args does some shady action at a distance + # see DBI.pm for more info + my $sql_maker = $self->sql_maker; + my ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset); + { + local $sql_maker->{_dbic_rs_attrs}; + ($op, $bind, $ident, $bind_attrs, $select, $cond, $order, $rows, $offset) = $self->_select_args(@_); + } + + if ( + ($rows || $offset) + || + not scalar $sql_maker->_order_by_chunks ($order->{order_by}) + ) { + # either limited RS or no ordering, just short circuit + return $self->next::method (@_); + } + + my ($sql, $prep_bind, @rest) = $self->next::method (@_); + $sql =~ s/^ \s* SELECT \s/SELECT TOP 100 PERCENT /xi; + + return wantarray + ? ($sql, $prep_bind, @rest) + : \[ "($sql)", @$prep_bind ] + ; +} + + # savepoint syntax is the same as in Sybase ASE sub _svp_begin { @@ -180,7 +247,7 @@ sub _sql_maker_opts { $self->{_sql_maker_opts} = { %$opts }; } - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; + return { limit_dialect => 'RowNumberOver', %{$self->{_sql_maker_opts}||{}} }; } 1; @@ -218,13 +285,15 @@ This is more dangerous, as inserting into a table with an on insert trigger that inserts into another table with an identity will give erroneous results on recent versions of SQL Server. -=head2 bulk_insert +=head2 identity insert Be aware that we have tried to make things as simple as possible for our users. -For MSSQL that means that when a user tries to do a populate/bulk_insert which -includes an autoincrementing column, we will try to tell the database to allow -the insertion of the autoinc column. But the user must have the db_ddladmin -role membership, otherwise you will get a fairly opaque error message. +For MSSQL that means that when a user tries to create a row, while supplying an +explicit value for an autoincrementing column, we will try to issue the +appropriate database call to make this possible, namely C. Unfortunately this operation in MSSQL requires the +C privilege, which is normally not included in the standard +write-permissions. =head1 AUTHOR