lib/DBIx/Class/Storage/DBI/ODBC/Microsoft_SQL_Server.pm

   1 package DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server;
   2 use strict;
   3 use warnings;
   4
   5 use base qw/DBIx::Class::Storage::DBI::MSSQL/;
   6 use mro 'c3';
   7
   8 use List::Util();
   9
  10 sub insert_bulk {
  11   my $self = shift;
  12   my ($source, $cols, $data) = @_;
  13
  14   my $identity_insert = 0;
  15
  16   COLUMNS:
  17   foreach my $col (@{$cols}) {
  18     if ($source->column_info($col)->{is_auto_increment}) {
  19       $identity_insert = 1;
  20       last COLUMNS;
  21     }
  22   }
  23
  24   if ($identity_insert) {
  25     my $table = $source->from;
  26     $self->dbh->do("SET IDENTITY_INSERT $table ON");
  27   }
  28
  29   $self->next::method(@_);
  30
  31   if ($identity_insert) {
  32     my $table = $source->from;
  33     $self->dbh->do("SET IDENTITY_INSERT $table OFF");
  34   }
  35 }
  36
  37 sub _prep_for_execute {
  38   my $self = shift;
  39   my ($op, $extra_bind, $ident, $args) = @_;
  40
  41 # cast MONEY values properly
  42   if ($op eq 'insert' || $op eq 'update') {
  43     my $fields = $args->[0];
  44     my $col_info = $self->_resolve_column_info($ident, [keys %$fields]);
  45
  46     for my $col (keys %$fields) {
  47       if ($col_info->{$col}{data_type} =~ /^money\z/i) {
  48         my $val = $fields->{$col};
  49         $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
  50       }
  51     }
  52   }
  53
  54   my ($sql, $bind) = $self->next::method (@_);
  55
  56   if ($op eq 'insert') {
  57     $sql .= ';SELECT SCOPE_IDENTITY()';
  58
  59     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
  60     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
  61
  62       my $table = $ident->from;
  63       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
  64       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
  65       $sql = "$identity_insert_on; $sql; $identity_insert_off";
  66     }
  67   }
  68
  69   return ($sql, $bind);
  70 }
  71
  72 sub _execute {
  73     my $self = shift;
  74     my ($op) = @_;
  75
  76     my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
  77     if ($op eq 'insert') {
  78       $self->{_scope_identity} = $sth->fetchrow_array;
  79       $sth->finish;
  80     }
  81
  82     return wantarray ? ($rv, $sth, @bind) : $rv;
  83 }
  84
  85 sub last_insert_id { shift->{_scope_identity} }
  86
  87 1;
  88
  89 __END__
  90
  91 =head1 NAME
  92
  93 DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
  94 to Microsoft SQL Server over ODBC
  95
  96 =head1 DESCRIPTION
  97
  98 This class implements support specific to Microsoft SQL Server over ODBC,
  99 including auto-increment primary keys and SQL::Abstract::Limit dialect.  It
 100 is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
 101 detects a MSSQL back-end.
 102
 103 =head1 IMPLEMENTATION NOTES
 104
 105 Microsoft SQL Server supports three methods of retrieving the IDENTITY
 106 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
 107 SCOPE_IDENTITY is used here because it is the safest.  However, it must
 108 be called is the same execute statement, not just the same connection.
 109
 110 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
 111 onto each INSERT to accommodate that requirement.
 112
 113 =head1 AUTHORS
 114
 115 Marc Mims C<< <marc@questright.com> >>
 116
 117 =head1 LICENSE
 118
 119 You may distribute this code under the same terms as Perl itself.
 120
 121 =cut
 122 # vim: sw=2 sts=2