X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FODBC%2FMicrosoft_SQL_Server.pm;h=6c3483e7c0a705e3437866ade53804a1bb1ed85a;hb=d68f21eedc64910ba75f23a8eff8c60be21ef126;hp=5aa1f0c0cdbb60f0f15adf472542bf9112cab985;hpb=77af494bb1ddc46a7a8eba467ab189daacccf32c;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm index 5aa1f0c..6c3483e 100644 --- a/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm @@ -2,16 +2,72 @@ package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server; use strict; use warnings; -use base qw/DBIx::Class::Storage::DBI/; +use base qw/DBIx::Class::Storage::DBI::MSSQL/; +use mro 'c3'; + +use List::Util(); + +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; + } + } + + if ($identity_insert) { + my $table = $source->from; + $self->dbh->do("SET IDENTITY_INSERT $table ON"); + } + + $self->next::method(@_); + + if ($identity_insert) { + my $table = $source->from; + $self->dbh->do("SET IDENTITY_INSERT $table OFF"); + } +} sub _prep_for_execute { - my $self = shift; - my ($op, $extra_bind, $ident, $args) = @_; + my $self = shift; + my ($op, $extra_bind, $ident, $args) = @_; + +# 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 %$col_info) { + if ($col_info->{$col}{data_type} eq 'money') { + my $val = $fields->{$col}; + + $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]]; + } + } + } + + my ($sql, $bind) = $self->next::method (@_); - my ($sql, $bind) = $self->SUPER::_prep_for_execute(@_); - $sql .= ';SELECT SCOPE_IDENTITY()' if $op eq 'insert'; + if ($op eq 'insert') { + $sql .= ';SELECT SCOPE_IDENTITY()'; - return ($sql, $bind); + 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); } sub _execute { @@ -29,26 +85,6 @@ sub _execute { sub last_insert_id { shift->{_scope_identity} } -sub sqlt_type { 'SQLServer' } - -sub _sql_maker_opts { - my ( $self, $opts ) = @_; - - if ( $opts ) { - $self->{_sql_maker_opts} = { %$opts }; - } - - return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} }; -} - -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 => '%F %T' ); -} - 1; __END__ @@ -75,17 +111,6 @@ be called is the same execute statement, not just the same connection. So, this implementation appends a SELECT SCOPE_IDENTITY() statement onto each INSERT to accommodate that requirement. -=head1 METHODS - -=head2 last_insert_id - -=head2 sqlt_type - -=head2 build_datetime_parser - -The resulting parser handles the MSSQL C type, but is almost -certainly not sufficient for the other MSSQL 2008 date/time types. - =head1 AUTHORS Marc Mims C<< >> @@ -95,3 +120,4 @@ Marc Mims C<< >> You may distribute this code under the same terms as Perl itself. =cut +# vim: sw=2 sts=2