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 use Carp::Clan qw/^DBIx::Class/;
   8 use List::Util();
   9
  10 __PACKAGE__->mk_group_accessors(simple => qw/
  11   _scope_identity _using_dynamic_cursors
  12 /);
  13
  14 =head1 NAME
  15
  16 DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server - Support specific
  17 to Microsoft SQL Server over ODBC
  18
  19 =head1 DESCRIPTION
  20
  21 This class implements support specific to Microsoft SQL Server over ODBC,
  22 including auto-increment primary keys and SQL::Abstract::Limit dialect.  It
  23 is loaded automatically by by DBIx::Class::Storage::DBI::ODBC when it
  24 detects a MSSQL back-end.
  25
  26 =head1 IMPLEMENTATION NOTES
  27
  28 Microsoft SQL Server supports three methods of retrieving the C<IDENTITY>
  29 value for inserted row: C<IDENT_CURRENT>, C<@@IDENTITY>, and C<SCOPE_IDENTITY()>.
  30 C<SCOPE_IDENTITY()> is used here because it is the safest.  However, it must
  31 be called is the same execute statement, not just the same connection.
  32
  33 So, this implementation appends a C<SELECT SCOPE_IDENTITY()> statement
  34 onto each C<INSERT> to accommodate that requirement.
  35
  36 If you use dynamic cursors with C<< odbc_cursortype => 2 >> or
  37 L</on_connect_call_use_dynamic_cursors> then the less accurate
  38 C<SELECT @@IDENTITY> is used instead.
  39
  40 =head1 MULTIPLE ACTIVE STATEMENTS
  41
  42 The following options are alternative ways to enable concurrent executing
  43 statement support. Each has its own advantages and drawbacks.
  44
  45 =head2 connect_call_use_dynamic_cursors
  46
  47 Use as:
  48
  49   on_connect_call => 'use_dynamic_cursors'
  50
  51 in your L<DBIx::Class::Storage::DBI/connect_info> as one way to enable multiple
  52 concurrent statements.
  53
  54 Will add C<< odbc_cursortype => 2 >> to your DBI connection attributes. See
  55 L<DBD::ODBC/odbc_cursortype> for more information.
  56
  57 This will not work with CODE ref connect_info's and will do nothing if you set
  58 C<odbc_cursortype> yourself.
  59
  60 B<WARNING:> this will break C<SCOPE_IDENTITY()>, and C<SELECT @@IDENTITY> will
  61 be used instead, which on SQL Server 2005 and later will return erroneous
  62 results on tables which have an on insert trigger that inserts into another
  63 table with an C<IDENTITY> column.
  64
  65 =cut
  66
  67 sub connect_call_use_dynamic_cursors {
  68   my $self = shift;
  69
  70   if (ref($self->_dbi_connect_info->[0]) eq 'CODE') {
  71     croak 'cannot set DBI attributes on CODE ref connect_infos';
  72   }
  73
  74   my $dbi_attrs = $self->_dbi_connect_info->[-1];
  75   $dbi_attrs ||= {};
  76
  77   if (not exists $dbi_attrs->{odbc_cursortype}) {
  78     # turn on support for multiple concurrent statements, unless overridden
  79     $self->_dbi_connect_info->[-1] = { %$dbi_attrs, odbc_cursortype => 2 };
  80     # will take effect next connection
  81     $self->disconnect;
  82     $self->_using_dynamic_cursors(1);
  83   }
  84 }
  85
  86 sub _rebless {
  87   no warnings 'uninitialized';
  88   my $self = shift;
  89
  90   if (ref($self->_dbi_connect_info->[0]) ne 'CODE' &&
  91       $self->_dbi_connect_info->[-1]{odbc_cursortype} == 2) {
  92     $self->_using_dynamic_cursors(1);
  93     return;
  94   }
  95
  96   $self->_using_dynamic_cursors(0);
  97 }
  98
  99 sub insert_bulk {
 100   my $self = shift;
 101   my ($source, $cols, $data) = @_;
 102
 103   my $identity_insert = 0;
 104
 105   COLUMNS:
 106   foreach my $col (@{$cols}) {
 107     if ($source->column_info($col)->{is_auto_increment}) {
 108       $identity_insert = 1;
 109       last COLUMNS;
 110     }
 111   }
 112
 113   if ($identity_insert) {
 114     my $table = $source->from;
 115     $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
 116   }
 117
 118   $self->next::method(@_);
 119
 120   if ($identity_insert) {
 121     my $table = $source->from;
 122     $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
 123   }
 124 }
 125
 126 sub _prep_for_execute {
 127   my $self = shift;
 128   my ($op, $extra_bind, $ident, $args) = @_;
 129
 130   my ($sql, $bind) = $self->next::method (@_);
 131
 132   if ($op eq 'insert') {
 133     $sql .= ';SELECT SCOPE_IDENTITY()';
 134
 135     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
 136     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
 137
 138       my $table = $ident->from;
 139       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
 140       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
 141       $sql = "$identity_insert_on; $sql; $identity_insert_off";
 142     }
 143   }
 144
 145   return ($sql, $bind);
 146 }
 147
 148 sub _execute {
 149     my $self = shift;
 150     my ($op) = @_;
 151
 152     my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
 153     if ($op eq 'insert') {
 154       my ($identity) = $sth->fetchrow_array;
 155       $sth->finish;
 156
 157       if ((not defined $identity) && $self->_using_dynamic_cursors) {
 158         ($identity) = $self->_dbh->selectrow_array('select @@identity');
 159       }
 160
 161       $self->_scope_identity($identity);
 162     }
 163
 164     return wantarray ? ($rv, $sth, @bind) : $rv;
 165 }
 166
 167 sub last_insert_id { shift->_scope_identity() }
 168
 169 1;
 170
 171 =head1 AUTHOR
 172
 173 See L<DBIx::Class/CONTRIBUTORS>.
 174
 175 =head1 LICENSE
 176
 177 You may distribute this code under the same terms as Perl itself.
 178
 179 =cut
 180
 181 # vim: sw=2 sts=2