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   _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 a CODE ref connect_info';
  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     my $connected = defined $self->_dbh;
  81     $self->disconnect;
  82     $self->ensure_connected if $connected;
  83     $self->_using_dynamic_cursors(1);
  84   }
  85 }
  86
  87 sub _rebless {
  88   no warnings 'uninitialized';
  89   my $self = shift;
  90
  91   if (ref($self->_dbi_connect_info->[0]) ne 'CODE' &&
  92       $self->_dbi_connect_info->[-1]{odbc_cursortype} == 2) {
  93     $self->_using_dynamic_cursors(1);
  94     return;
  95   }
  96
  97   $self->_using_dynamic_cursors(0);
  98 }
  99
 100 =head2 connect_call_use_server_cursors
 101
 102 Use as:
 103
 104   on_connect_call => 'use_server_cursors'
 105
 106 May allow multiple active select statements. See
 107 L<DBD::ODBC/odbc_SQL_ROWSET_SIZE> for more information.
 108
 109 Takes an optional parameter for the value to set the attribute to, default is
 110 C<2>.
 111
 112 B<WARNING>: this does not work on all versions of SQL Server, and may lock up
 113 your database!
 114
 115 =cut
 116
 117 =head2 connect_call_use_mars
 118
 119 Use as:
 120
 121   on_connect_call => 'use_mars'
 122
 123 Use to enable a feature of SQL Server 2005 and later, "Multiple Active Result
 124 Sets". See L<DBD::ODBC::FAQ/Does DBD::ODBC support Multiple Active Statements?>
 125 for more information.
 126
 127 B<WARNING>: This has implications for the way transactions are handled.
 128
 129 =cut
 130
 131 sub connect_call_use_mars {
 132   my $self = shift;
 133
 134   my $dsn = $self->_dbi_connect_info->[0];
 135
 136   if (ref($dsn) eq 'CODE') {
 137     croak 'cannot change the DBI DSN on a CODE ref connect_info';
 138   }
 139
 140   if ($dsn !~ /MARS_Connection=/) {
 141     $self->_dbi_connect_info->[0] = "$dsn;MARS_Connection=Yes";
 142     my $connected = defined $self->_dbh;
 143     $self->disconnect;
 144     $self->ensure_connected if $connected;
 145   }
 146 }
 147
 148 sub insert_bulk {
 149   my $self = shift;
 150   my ($source, $cols, $data) = @_;
 151
 152   my $identity_insert = 0;
 153
 154   COLUMNS:
 155   foreach my $col (@{$cols}) {
 156     if ($source->column_info($col)->{is_auto_increment}) {
 157       $identity_insert = 1;
 158       last COLUMNS;
 159     }
 160   }
 161
 162   if ($identity_insert) {
 163     my $table = $source->from;
 164     $self->_get_dbh->do("SET IDENTITY_INSERT $table ON");
 165   }
 166
 167   $self->next::method(@_);
 168
 169   if ($identity_insert) {
 170     my $table = $source->from;
 171     $self->_get_dbh->do("SET IDENTITY_INSERT $table OFF");
 172   }
 173 }
 174
 175 sub _prep_for_execute {
 176   my $self = shift;
 177   my ($op, $extra_bind, $ident, $args) = @_;
 178
 179   my ($sql, $bind) = $self->next::method (@_);
 180
 181   if ($op eq 'insert') {
 182     $sql .= ';SELECT SCOPE_IDENTITY()';
 183
 184     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
 185     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
 186
 187       my $table = $ident->from;
 188       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
 189       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
 190       $sql = "$identity_insert_on; $sql; $identity_insert_off";
 191     }
 192   }
 193
 194   return ($sql, $bind);
 195 }
 196
 197 sub _execute {
 198     my $self = shift;
 199     my ($op) = @_;
 200
 201     my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
 202     if ($op eq 'insert') {
 203       my ($identity) = $sth->fetchrow_array;
 204       $sth->finish;
 205
 206       if ((not defined $identity) && $self->_using_dynamic_cursors) {
 207         ($identity) = $self->_dbh->selectrow_array('select @@identity');
 208       }
 209
 210       $self->_identity($identity);
 211     }
 212
 213     return wantarray ? ($rv, $sth, @bind) : $rv;
 214 }
 215
 216 sub last_insert_id { shift->_identity() }
 217
 218 1;
 219
 220 =head1 AUTHOR
 221
 222 See L<DBIx::Class/CONTRIBUTORS>.
 223
 224 =head1 LICENSE
 225
 226 You may distribute this code under the same terms as Perl itself.
 227
 228 =cut
 229
 230 # vim: sw=2 sts=2