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 # cast MONEY values properly
 180   if ($op eq 'insert' || $op eq 'update') {
 181     my $fields = $args->[0];
 182     my $col_info = $self->_resolve_column_info($ident, [keys %$fields]);
 183
 184     for my $col (keys %$fields) {
 185       if ($col_info->{$col}{data_type} =~ /^money\z/i) {
 186         my $val = $fields->{$col};
 187         $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
 188       }
 189     }
 190   }
 191
 192   my ($sql, $bind) = $self->next::method (@_);
 193
 194   if ($op eq 'insert') {
 195     $sql .= ';SELECT SCOPE_IDENTITY()';
 196
 197     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
 198     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
 199
 200       my $table = $ident->from;
 201       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
 202       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
 203       $sql = "$identity_insert_on; $sql; $identity_insert_off";
 204     }
 205   }
 206
 207   return ($sql, $bind);
 208 }
 209
 210 sub _execute {
 211     my $self = shift;
 212     my ($op) = @_;
 213
 214     my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
 215     if ($op eq 'insert') {
 216       my ($identity) = $sth->fetchrow_array;
 217       $sth->finish;
 218
 219       if ((not defined $identity) && $self->_using_dynamic_cursors) {
 220         ($identity) = $self->_dbh->selectrow_array('select @@identity');
 221       }
 222
 223       $self->_identity($identity);
 224     }
 225
 226     return wantarray ? ($rv, $sth, @bind) : $rv;
 227 }
 228
 229 sub last_insert_id { shift->_identity() }
 230
 231 1;
 232
 233 =head1 AUTHOR
 234
 235 See L<DBIx::Class/CONTRIBUTORS>.
 236
 237 =head1 LICENSE
 238
 239 You may distribute this code under the same terms as Perl itself.
 240
 241 =cut
 242
 243 # vim: sw=2 sts=2