X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=dbsrgits%2FDBIx-Class.git;a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=6bdb02788f1184c3b5b637293760cf2a64ea6f04;hp=c4611b3455ea3769c3c0ef8b86b34070fb49a832;hb=48580715af3072905f2c71dc27e7f70f21a11338;hpb=afcfff010f5a1d6dbc3a5fb6dfbaeb6246c33372 diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index c4611b3..6bdb027 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -16,24 +16,54 @@ __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL'); sub _set_identity_insert { my ($self, $table) = @_; - $self->_get_dbh->do (sprintf + + my $sql = sprintf ( 'SET IDENTITY_INSERT %s ON', - $self->sql_maker->_quote ($table) + $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) = @_; - if (List::Util::first + my $is_identity_insert = (List::Util::first { $source->column_info ($_)->{is_auto_increment} } (@{$cols}) - ) { - $self->_set_identity_insert ($source->name); + ) + ? 1 + : 0; + + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); } $self->next::method(@_); + + if ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); + } } # support MSSQL GUID column types @@ -73,12 +103,21 @@ sub insert { $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); + 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; } @@ -121,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) { @@ -139,6 +178,33 @@ sub _execute { 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; + + my ($sql, $prep_bind, @rest) = $self->next::method (@_); + + # see if this is an ordered subquery + my $attrs = $_[3]; + if ( scalar $self->_parse_order_by ($attrs->{order_by}) ) { + $self->throw_exception( + 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL + ') unless $attrs->{unsafe_subselect_ok}; + my $max = 2 ** 32; + $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi; + } + + return wantarray + ? ($sql, $prep_bind, @rest) + : \[ "($sql)", @$prep_bind ] + ; +} + + # savepoint syntax is the same as in Sybase ASE sub _svp_begin { @@ -166,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 ($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; + + 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}||{}} + }; + } - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; + my $maker = $self->next::method (@_); } - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; + return $self->_sql_maker; } 1; @@ -211,13 +298,63 @@ 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. + +=head2 Ordered Subselects + +If you attempted the following query (among many others) in Microsoft SQL +Server + + $rs->search ({}, { + prefetch => 'relation', + rows => 2, + offset => 3, + }); + +You may be surprised to receive an exception. The reason for this is a quirk +in the MSSQL engine itself, and sadly doesn't have a sensible workaround due +to the way DBIC is built. DBIC can do truly wonderful things with the aid of +subselects, and does so automatically when necessary. The list of situations +when a subselect is necessary is long and still changes often, so it can not +be exhaustively enumerated here. The general rule of thumb is a joined +L relationship with limit/group +applied to the left part of the join. + +In its "pursuit of standards" Microsft SQL Server goes to great lengths to +forbid the use of ordered subselects. This breaks a very useful group of +searches like "Give me things number 4 to 6 (ordered by name), and prefetch +all their relations, no matter how many". 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 subselects 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 preferably regression-test) the return of every such +ResultSet individually. The example above would work if written like: + + $rs->search ({}, { + unsafe_subselect_ok => 1, + prefetch => 'relation', + rows => 2, + offset => 3, + }); + +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 subselect is necessary for an operation, and you believe there is a +different/better way to get the same result - please file a bugreport. =head1 AUTHOR