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} eq 'money') {
  48         my $val = $fields->{$col};
  49
  50         $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
  51       }
  52     }
  53   }
  54
  55   my ($sql, $bind) = $self->next::method (@_);
  56
  57   if ($op eq 'insert') {
  58     $sql .= ';SELECT SCOPE_IDENTITY()';
  59
  60     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
  61     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
  62
  63       my $table = $ident->from;
  64       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
  65       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
  66       $sql = "$identity_insert_on; $sql; $identity_insert_off";
  67     }
  68   }
  69
  70   return ($sql, $bind);
  71 }
  72
  73 sub _execute {
  74     my $self = shift;
  75     my ($op) = @_;
  76
  77     my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
  78     if ($op eq 'insert') {
  79       $self->{_scope_identity} = $sth->fetchrow_array;
  80       $sth->finish;
  81     }
  82
  83     return wantarray ? ($rv, $sth, @bind) : $rv;
  84 }
  85
  86 sub last_insert_id { shift->{_scope_identity} }
  87
  88 1;
  89
  90 __END__
  91
  92 =head1 NAME
  93
  94 DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
  95 to Microsoft SQL Server over ODBC
  96
  97 =head1 DESCRIPTION
  98
  99 This class implements support specific to Microsoft SQL Server over ODBC,
 100 including auto-increment primary keys and SQL::Abstract::Limit dialect.  It
 101 is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
 102 detects a MSSQL back-end.
 103
 104 =head1 IMPLEMENTATION NOTES
 105
 106 Microsoft SQL Server supports three methods of retrieving the IDENTITY
 107 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
 108 SCOPE_IDENTITY is used here because it is the safest.  However, it must
 109 be called is the same execute statement, not just the same connection.
 110
 111 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
 112 onto each INSERT to accommodate that requirement.
 113
 114 =head1 AUTHORS
 115
 116 Marc Mims C<< <marc@questright.com> >>
 117
 118 =head1 LICENSE
 119
 120 You may distribute this code under the same terms as Perl itself.
 121
 122 =cut
 123 # vim: sw=2 sts=2