X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FMSSQL.pm;h=e0ff02f227c96dc5bece114ac2dce4b5f8159415;hb=70551c3d5c3f7cc980306200e8712fda39a5a4e6;hp=52180701bb7f3287fecc84fc21f628c71ade1409;hpb=9780718f9c36738245f90b1f036998c3b076cffc;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/MSSQL.pm b/lib/DBIx/Class/Storage/DBI/MSSQL.pm index 5218070..e0ff02f 100644 --- a/lib/DBIx/Class/Storage/DBI/MSSQL.pm +++ b/lib/DBIx/Class/Storage/DBI/MSSQL.pm @@ -6,65 +6,49 @@ use warnings; use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/; use mro 'c3'; use Try::Tiny; - -use List::Util(); +use List::Util 'first'; +use namespace::clean; __PACKAGE__->mk_group_accessors(simple => qw/ - _identity _identity_method + _identity _identity_method _pre_insert_sql _post_insert_sql /); -__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL'); +__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL'); -sub _set_identity_insert { - my ($self, $table) = @_; +__PACKAGE__->sql_quote_char([qw/[ ]/]); - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s ON', - $self->sql_maker->_quote ($table), - ); +__PACKAGE__->datetime_parser_type ( + 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format' +); - 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 { +__PACKAGE__->new_guid('NEWID()'); + +sub _set_identity_insert { my ($self, $table) = @_; - my $sql = sprintf ( - 'SET IDENTITY_INSERT %s OFF', - $self->sql_maker->_quote ($table), - ); + my $stmt = 'SET IDENTITY_INSERT %s %s'; + $table = $self->sql_maker->_quote($table); - my $dbh = $self->_get_dbh; - $dbh->do ($sql); + $self->_pre_insert_sql (sprintf $stmt, $table, 'ON'); + $self->_post_insert_sql(sprintf $stmt, $table, 'OFF'); } sub insert_bulk { my $self = shift; my ($source, $cols, $data) = @_; - my $is_identity_insert = (List::Util::first - { $source->column_info ($_)->{is_auto_increment} } - (@{$cols}) - ) - ? 1 - : 0; + my $is_identity_insert = + (first { $_->{is_auto_increment} } values %{ $source->columns_info($cols) } ) + ? 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); - } } sub insert { @@ -73,9 +57,8 @@ sub insert { my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] ); - my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) - ? 1 - : 0; + my $is_identity_insert = + (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0; if ($is_identity_insert) { $self->_set_identity_insert ($source->name); @@ -83,26 +66,26 @@ sub insert { my $updated_cols = $self->next::method(@_); - if ($is_identity_insert) { - $self->_unset_identity_insert ($source->name); - } - return $updated_cols; } sub _prep_for_execute { my $self = shift; - my ($op, $extra_bind, $ident, $args) = @_; + my ($op, $ident, $args) = @_; # cast MONEY values properly if ($op eq 'insert' || $op eq 'update') { my $fields = $args->[0]; + my $colinfo = $ident->columns_info([keys %$fields]); + for my $col (keys %$fields) { # $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) { + if ( + $colinfo->{$col}{data_type} + && + $colinfo->{$col}{data_type} =~ /^money\z/i + ) { my $val = $fields->{$col}; $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; } @@ -112,8 +95,15 @@ sub _prep_for_execute { my ($sql, $bind) = $self->next::method (@_); if ($op eq 'insert') { - $sql .= ';SELECT SCOPE_IDENTITY()'; - + if (my $prepend = $self->_pre_insert_sql) { + $sql = "${prepend}\n${sql}"; + $self->_pre_insert_sql(undef); + } + if (my $append = $self->_post_insert_sql) { + $sql = "${sql}\n${append}"; + $self->_post_insert_sql(undef); + } + $sql .= "\nSELECT SCOPE_IDENTITY()"; } return ($sql, $bind); @@ -123,7 +113,7 @@ sub _execute { my $self = shift; my ($op) = @_; - my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_); + my ($rv, $sth, @bind) = $self->next::method(@_); if ($op eq 'insert') { @@ -149,7 +139,7 @@ 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 +# 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 { @@ -162,12 +152,12 @@ sub _select_args_to_query { if ( $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi && - scalar $self->_parse_order_by ($attrs->{order_by}) + scalar $self->_extract_order_criteria ($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; + my $max = $self->sql_maker->__max_int; $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi; } @@ -180,58 +170,43 @@ sub _select_args_to_query { # savepoint syntax is the same as in Sybase ASE -sub _svp_begin { +sub _exec_svp_begin { my ($self, $name) = @_; - $self->_get_dbh->do("SAVE TRANSACTION $name"); + $self->_dbh->do("SAVE TRANSACTION $name"); } # A new SAVE TRANSACTION with the same name releases the previous one. -sub _svp_release { 1 } +sub _exec_svp_release { 1 } -sub _svp_rollback { +sub _exec_svp_rollback { my ($self, $name) = @_; - $self->_get_dbh->do("ROLLBACK TRANSACTION $name"); + $self->_dbh->do("ROLLBACK TRANSACTION $name"); } -sub datetime_parser_type { - 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format' -} - sub sqlt_type { 'SQLServer' } -sub sql_maker { +sub sql_limit_dialect { my $self = shift; - unless ($self->_sql_maker) { - unless ($self->{_sql_maker_opts}{limit_dialect}) { - my $have_rno = 0; + my $supports_rno = 0; - if (exists $self->_server_info->{normalized_dbms_version}) { - $have_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())'); - $have_rno = 1; - }; - } - - $self->{_sql_maker_opts} = { - limit_dialect => ($have_rno ? 'RowNumberOver' : 'Top'), - %{$self->{_sql_maker_opts}||{}} - }; - } - - my $maker = $self->next::method (@_); + 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 $self->_sql_maker; + return $supports_rno ? 'RowNumberOver' : 'Top'; } sub _ping { @@ -242,20 +217,18 @@ sub _ping { local $dbh->{RaiseError} = 1; local $dbh->{PrintError} = 0; - my $rc = 1; - try { + return try { $dbh->do('select 1'); + 1; } catch { - $rc = 0; + 0; }; - - return $rc; } package # hide from PAUSE DBIx::Class::Storage::DBI::MSSQL::DateTime::Format; -my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T +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);