lib/DBIx/Class/Storage/DBI/MSSQL.pm

   1 package DBIx::Class::Storage::DBI::MSSQL;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
   7 use mro 'c3';
   8
   9 use List::Util();
  10
  11 __PACKAGE__->mk_group_accessors(simple => qw/
  12   _identity _identity_method
  13 /);
  14
  15 __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
  16
  17 sub insert_bulk {
  18   my $self = shift;
  19   my ($source, $cols, $data) = @_;
  20
  21   my $identity_insert = 0;
  22
  23   COLUMNS:
  24   foreach my $col (@{$cols}) {
  25     if ($source->column_info($col)->{is_auto_increment}) {
  26       $identity_insert = 1;
  27       last COLUMNS;
  28     }
  29   }
  30
  31   if ($identity_insert) {
  32     my $table = $source->from;
  33     $self->dbh->do("SET IDENTITY_INSERT $table ON");
  34   }
  35
  36   $self->next::method(@_);
  37
  38   if ($identity_insert) {
  39     my $table = $source->from;
  40     $self->dbh->do("SET IDENTITY_INSERT $table OFF");
  41   }
  42 }
  43
  44 sub _prep_for_execute {
  45   my $self = shift;
  46   my ($op, $extra_bind, $ident, $args) = @_;
  47
  48 # cast MONEY values properly
  49   if ($op eq 'insert' || $op eq 'update') {
  50     my $fields = $args->[0];
  51     my $col_info = $self->_resolve_column_info($ident, [keys %$fields]);
  52
  53     for my $col (keys %$fields) {
  54       if ($col_info->{$col}{data_type} =~ /^money\z/i) {
  55         my $val = $fields->{$col};
  56         $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
  57       }
  58     }
  59   }
  60
  61   my ($sql, $bind) = $self->next::method (@_);
  62
  63   if ($op eq 'insert') {
  64     $sql .= ';SELECT SCOPE_IDENTITY()';
  65
  66     my $col_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
  67     if (List::Util::first { $_->{is_auto_increment} } (values %$col_info) ) {
  68
  69       my $table = $ident->from;
  70       my $identity_insert_on = "SET IDENTITY_INSERT $table ON";
  71       my $identity_insert_off = "SET IDENTITY_INSERT $table OFF";
  72       $sql = "$identity_insert_on; $sql; $identity_insert_off";
  73     }
  74   }
  75
  76   return ($sql, $bind);
  77 }
  78
  79 sub _execute {
  80   my $self = shift;
  81   my ($op) = @_;
  82
  83   my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
  84   if ($op eq 'insert') {
  85     $self->_identity($self->_fetch_identity($sth));
  86   }
  87
  88   return wantarray ? ($rv, $sth, @bind) : $rv;
  89 }
  90
  91 sub _fetch_identity {
  92   my ($self, $sth) = @_;
  93   my ($identity) = $sth->fetchrow_array;
  94   $sth->finish;
  95
  96   if ((not defined $identity) && $self->_identity_method &&
  97         $self->_identity_method eq '@@identity') {
  98     ($identity) = $self->_dbh->selectrow_array('select @@identity');
  99   }
 100
 101   return $identity;
 102 }
 103
 104 sub last_insert_id { shift->_identity }
 105
 106 # savepoint syntax is the same as in Sybase ASE
 107
 108 sub _svp_begin {
 109   my ($self, $name) = @_;
 110
 111   $self->dbh->do("SAVE TRANSACTION $name");
 112 }
 113
 114 # A new SAVE TRANSACTION with the same name releases the previous one.
 115 sub _svp_release { 1 }
 116
 117 sub _svp_rollback {
 118   my ($self, $name) = @_;
 119
 120   $self->dbh->do("ROLLBACK TRANSACTION $name");
 121 }
 122
 123 sub build_datetime_parser {
 124   my $self = shift;
 125   my $type = "DateTime::Format::Strptime";
 126   eval "use ${type}";
 127   $self->throw_exception("Couldn't load ${type}: $@") if $@;
 128   return $type->new( pattern => '%Y-%m-%d %H:%M:%S' );  # %F %T
 129 }
 130
 131 sub sqlt_type { 'SQLServer' }
 132
 133 sub _sql_maker_opts {
 134   my ( $self, $opts ) = @_;
 135
 136   if ( $opts ) {
 137     $self->{_sql_maker_opts} = { %$opts };
 138   }
 139
 140   return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
 141 }
 142
 143 1;
 144
 145 =head1 NAME
 146
 147 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
 148 in DBIx::Class
 149
 150 =head1 SYNOPSIS
 151
 152 This is the base class for Microsoft SQL Server support, used by
 153 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
 154 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
 155
 156 =head1 IMPLEMENTATION NOTES
 157
 158 Microsoft SQL Server supports three methods of retrieving the IDENTITY
 159 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
 160 SCOPE_IDENTITY is used here because it is the safest.  However, it must
 161 be called is the same execute statement, not just the same connection.
 162
 163 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
 164 onto each INSERT to accommodate that requirement.
 165
 166 C<SELECT @@IDENTITY> can also be used by issuing:
 167
 168   $self->_identity_method('@@identity');
 169
 170 it will only be used if SCOPE_IDENTITY() fails.
 171
 172 This is more dangerous, as inserting into a table with an on insert trigger that
 173 inserts into another table with an identity will give erroneous results on
 174 recent versions of SQL Server.
 175
 176 =head1 AUTHOR
 177
 178 See L<DBIx::Class/CONTRIBUTORS>.
 179
 180 =head1 LICENSE
 181
 182 You may distribute this code under the same terms as Perl itself.
 183
 184 =cut