X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=9cde4b9c172256420427b636123678df01317a48;hb=d5dedbd62928f65a9071b4d9b6d56c6b663a073b;hp=b0da553b425e993b98fda0eb16dbe7939cce6d3c;hpb=9ae966b90f1220796b4fef69a97e7c4fb360d6bc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index b0da553..9cde4b9 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -3,77 +3,85 @@ package DBIx::Class::Storage::DBI::MSSQL; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/; +use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; - -use List::Util(); +use Try::Tiny; +use List::Util 'first'; +use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ _identity _identity_method /); -__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL'); +__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 $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); +} 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 = + (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); } } -# support MSSQL GUID column types - sub insert { my $self = shift; my ($source, $to_insert) = @_; - my $updated_cols = {}; - - my %guid_cols; - my @pk_cols = $source->primary_columns; - my %pk_cols; - @pk_cols{@pk_cols} = (); + my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] ); - my @pk_guids = grep { - $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i - } @pk_cols; + my $is_identity_insert = + (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0; - my @auto_guids = grep { - $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i - && - $source->column_info($_)->{auto_nextval} - } grep { not exists $pk_cols{$_} } $source->columns; + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); + } - my @get_guids_for = - grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids); + my $updated_cols = $self->next::method(@_); - 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 ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); } - $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } }; - return $updated_cols; } @@ -87,7 +95,9 @@ sub _prep_for_execute { for my $col (keys %$fields) { # $ident is a result source object with INSERT/UPDATE ops - if ($ident->column_info ($col)->{data_type} =~ /^money\z/i) { + 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 ]]; } @@ -99,14 +109,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); @@ -122,7 +124,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) = try { $sth->fetchrow_array }; # SCOPE_IDENTITY failed, but we can do something else if ( (! $identity) && $self->_identity_method) { @@ -140,6 +142,37 @@ 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 ( + $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi + && + 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 = $self->sql_maker->__max_int; + $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 { @@ -157,24 +190,96 @@ sub _svp_rollback { $self->_get_dbh->do("ROLLBACK TRANSACTION $name"); } -sub build_datetime_parser { - my $self = shift; - my $type = "DateTime::Format::Strptime"; - eval "use ${type}"; - $self->throw_exception("Couldn't load ${type}: $@") if $@; - return $type->new( pattern => '%Y-%m-%d %H:%M:%S' ); # %F %T +sub datetime_parser_type { + 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format' } sub sqlt_type { 'SQLServer' } -sub _sql_maker_opts { - my ( $self, $opts ) = @_; +sub sql_limit_dialect { + my $self = shift; + + my $supports_rno = 0; - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; + if (exists $self->_server_info->{normalized_dbms_version}) { + $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9; + } + else { + # User is connecting via DBD::Sybase and has no permission to run + # stored procedures like xp_msver, or version detection failed for some + # other reason. + # So, we use a query to check if RNO is implemented. + try { + $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())'); + $supports_rno = 1; + }; } - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; + return $supports_rno ? 'RowNumberOver' : 'Top'; +} + +sub _ping { + my $self = shift; + + my $dbh = $self->_dbh or return 0; + + local $dbh->{RaiseError} = 1; + local $dbh->{PrintError} = 0; + + return try { + $dbh->do('select 1'); + 1; + } catch { + 0; + }; +} + +package # hide from PAUSE + DBIx::Class::Storage::DBI::MSSQL::DateTime::Format; + +my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T +my $smalldatetime_format = '%Y-%m-%d %H:%M:%S'; + +my ($datetime_parser, $smalldatetime_parser); + +sub parse_datetime { + shift; + require DateTime::Format::Strptime; + $datetime_parser ||= DateTime::Format::Strptime->new( + pattern => $datetime_format, + on_error => 'croak', + ); + return $datetime_parser->parse_datetime(shift); +} + +sub format_datetime { + shift; + require DateTime::Format::Strptime; + $datetime_parser ||= DateTime::Format::Strptime->new( + pattern => $datetime_format, + on_error => 'croak', + ); + return $datetime_parser->format_datetime(shift); +} + +sub parse_smalldatetime { + shift; + require DateTime::Format::Strptime; + $smalldatetime_parser ||= DateTime::Format::Strptime->new( + pattern => $smalldatetime_format, + on_error => 'croak', + ); + return $smalldatetime_parser->parse_datetime(shift); +} + +sub format_smalldatetime { + shift; + require DateTime::Format::Strptime; + $smalldatetime_parser ||= DateTime::Format::Strptime->new( + pattern => $smalldatetime_format, + on_error => 'croak', + ); + return $smalldatetime_parser->format_datetime(shift); } 1; @@ -192,6 +297,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 @@ -210,9 +317,67 @@ 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 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 -See L. +See L and L. =head1 LICENSE