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