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