X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=03311809716199c340e4b50580aca2428445caf7;hb=010f82a001cea2c6067fd8a080e29eb3310c2ecb;hp=a03e8a3d8b3339e4c442dd0dcb65baf9536e04a6;hpb=08cdc412c55790214ac6aac54d729bc1902a6e79;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index a03e8a3..0331180 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -14,31 +14,111 @@ __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; + my $is_identity_insert = (List::Util::first + { $source->column_info ($_)->{is_auto_increment} } + (@{$cols}) + ) + ? 1 + : 0; - COLUMNS: - foreach my $col (@{$cols}) { - if ($source->column_info($col)->{is_auto_increment}) { - $identity_insert = 1; - last COLUMNS; - } + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); } - if ($identity_insert) { - my $table = $source->from; - $self->dbh->do("SET IDENTITY_INSERT $table ON"); + $self->next::method(@_); + + if ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); } +} - $self->next::method(@_); +# support MSSQL GUID column types + +sub insert { + my $self = shift; + my ($source, $to_insert) = @_; + + my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] ); - if ($identity_insert) { - my $table = $source->from; - $self->dbh->do("SET IDENTITY_INSERT $table OFF"); + my %guid_cols; + my @pk_cols = $source->primary_columns; + my %pk_cols; + @pk_cols{@pk_cols} = (); + + my @pk_guids = grep { + $source->column_info($_)->{data_type} + && + $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i + } @pk_cols; + + my @auto_guids = grep { + $source->column_info($_)->{data_type} + && + $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i + && + $source->column_info($_)->{auto_nextval} + } grep { not exists $pk_cols{$_} } $source->columns; + + 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; } sub _prep_for_execute { @@ -48,10 +128,12 @@ sub _prep_for_execute { # cast MONEY values properly if ($op eq 'insert' || $op eq 'update') { my $fields = $args->[0]; - my $col_info = $self->_resolve_column_info($ident, [keys %$fields]); for my $col (keys %$fields) { - if ($col_info->{$col}{data_type} =~ /^money\z/i) { + # $ident is a result source object with INSERT/UPDATE ops + if ($ident->column_info ($col)->{data_type} + && + $ident->column_info ($col)->{data_type} =~ /^money\z/i) { my $val = $fields->{$col}; $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; } @@ -63,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); @@ -81,27 +155,72 @@ sub _execute { my ($op) = @_; my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); + if ($op eq 'insert') { - $self->_identity($self->_fetch_identity($sth)); + + # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked + # on in _prep_for_execute above + my ($identity) = eval { $sth->fetchrow_array }; + + # SCOPE_IDENTITY failed, but we can do something else + if ( (! $identity) && $self->_identity_method) { + ($identity) = $self->_dbh->selectrow_array( + 'select ' . $self->_identity_method + ); + } + + $self->_identity($identity); + $sth->finish; } return wantarray ? ($rv, $sth, @bind) : $rv; } -sub _fetch_identity { - my ($self, $sth) = @_; - my ($identity) = $sth->fetchrow_array; - $sth->finish; +sub last_insert_id { shift->_identity } + +# +# MSSQL is retarded wrt ordered subselects. One needs to add a TOP +# to *all* subqueries, but one also can't use TOP 100 PERCENT +# http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931 +# +sub _select_args_to_query { + my $self = shift; - if ((not defined $identity) && $self->_identity_method && - $self->_identity_method eq '@@identity') { - ($identity) = $self->_dbh->selectrow_array('select @@identity'); + my ($sql, $prep_bind, @rest) = $self->next::method (@_); + + # see if this is an ordered subquery + my $attrs = $_[3]; + if ( scalar $self->sql_maker->_order_by_chunks ($attrs->{order_by}) ) { + $self->throw_exception( + 'An ordered subquery encountered. Please see "Ordered Subqueries" in DBIx::Class::Storage::DBI::MSSQL + ') unless $attrs->{unsafe_subquery}; + my $max = 2 ** 32; + $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi; } - return $identity; + return wantarray + ? ($sql, $prep_bind, @rest) + : \[ "($sql)", @$prep_bind ] + ; } -sub last_insert_id { shift->_identity } + +# savepoint syntax is the same as in Sybase ASE + +sub _svp_begin { + my ($self, $name) = @_; + + $self->_get_dbh->do("SAVE TRANSACTION $name"); +} + +# A new SAVE TRANSACTION with the same name releases the previous one. +sub _svp_release { 1 } + +sub _svp_rollback { + my ($self, $name) = @_; + + $self->_get_dbh->do("ROLLBACK TRANSACTION $name"); +} sub build_datetime_parser { my $self = shift; @@ -113,14 +232,35 @@ sub build_datetime_parser { sub sqlt_type { 'SQLServer' } -sub _sql_maker_opts { - my ( $self, $opts ) = @_; +sub _get_mssql_version { + my $self = shift; + + my $data = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion'); - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; + if ($data->{Character_Value} =~ /^(\d+)\./) { + return $1; + } else { + $self->throw_exception(q{Your ProductVersion's Character_Value is missing or malformed!}); } +} + +sub sql_maker { + my $self = shift; - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; + unless ($self->_sql_maker) { + unless ($self->{_sql_maker_opts}{limit_dialect}) { + my $version = eval { $self->_get_mssql_version; } || 0; + + $self->{_sql_maker_opts} = { + limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'), + %{$self->{_sql_maker_opts}||{}} + }; + } + + my $maker = $self->next::method (@_); + } + + return $self->_sql_maker; } 1; @@ -138,6 +278,8 @@ L. =head1 IMPLEMENTATION NOTES +=head2 IDENTITY information + Microsoft SQL Server supports three methods of retrieving the IDENTITY value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY(). SCOPE_IDENTITY is used here because it is the safest. However, it must @@ -156,6 +298,55 @@ 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 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 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. + +=head2 Ordered Subqueries + + # this is deemed unsafe and throws under MSSQL + $rs->search ({}, { + prefetch => 'relation', + rows => 2, + offset => 3, + }); + + # however this should work (but please check what comes back from the db) + $rs->search ({}, { + unsafe_subquery => 1, + prefetch => 'relation', + rows => 2, + offset => 3, + }); + +DBIC can do truly wonderful things with the aid of subqueries, and does so +automatically when necessary. Especially useful are ordered subqueries, +which allow searches like "Give me things number 4 to 6 (ordered by name), and +prefetch all their relations, no matter how many". In its pursuit of standards +Microsft SQL Server goes to great lengths to forbid the use of ordered +subqueries. While there is a hack which fools the syntax checker, the optimizer +may B. Testing has determined that while +such breakage does occur (the test suite contains an explicit test which +demonstrates the problem), it is relative rare. The benefits of ordered +subqueries are on the other hand too great to be outright disabled for MSSQL. + +Thus compromise between usability and perfection is the MSSQL-specific +L C. +It is deliberately not possible to set this on the Storage level, as the user +should inspect (and preferrably regression-test) the return of every such +ResultSet individually. + +If it is possible to rewrite the search() in a way that will avoid the need +for this flag - you are urged to do so. If DBIC internals insist that an +ordered subquery is necessary for an operation, and you believe there is a +differnt/better way to get the same result - please file a bugreport. + =head1 AUTHOR See L.