1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
11 __PACKAGE__->mk_group_accessors(simple => qw/
12 _identity _identity_method
15 __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
17 sub _set_identity_insert {
18 my ($self, $table) = @_;
21 'SET IDENTITY_INSERT %s ON',
22 $self->sql_maker->_quote ($table),
25 my $dbh = $self->_get_dbh;
26 eval { $dbh->do ($sql) };
28 $self->throw_exception (sprintf "Error executing '%s': %s",
37 my ($source, $cols, $data) = @_;
40 { $source->column_info ($_)->{is_auto_increment} }
43 $self->_set_identity_insert ($source->name);
46 $self->next::method(@_);
49 # support MSSQL GUID column types
53 my ($source, $to_insert) = @_;
55 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
58 my @pk_cols = $source->primary_columns;
60 @pk_cols{@pk_cols} = ();
63 $source->column_info($_)->{data_type}
65 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
68 my @auto_guids = grep {
69 $source->column_info($_)->{data_type}
71 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
73 $source->column_info($_)->{auto_nextval}
74 } grep { not exists $pk_cols{$_} } $source->columns;
77 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
79 my $updated_cols = {};
81 for my $guid_col (@get_guids_for) {
82 my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
83 $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
86 if (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) ) {
87 $self->_set_identity_insert ($source->name);
90 $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
95 sub _prep_for_execute {
97 my ($op, $extra_bind, $ident, $args) = @_;
99 # cast MONEY values properly
100 if ($op eq 'insert' || $op eq 'update') {
101 my $fields = $args->[0];
103 for my $col (keys %$fields) {
104 # $ident is a result source object with INSERT/UPDATE ops
105 if ($ident->column_info ($col)->{data_type}
107 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
108 my $val = $fields->{$col};
109 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
114 my ($sql, $bind) = $self->next::method (@_);
116 if ($op eq 'insert') {
117 $sql .= ';SELECT SCOPE_IDENTITY()';
121 return ($sql, $bind);
128 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
130 if ($op eq 'insert') {
132 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
133 # on in _prep_for_execute above
134 my ($identity) = $sth->fetchrow_array;
136 # SCOPE_IDENTITY failed, but we can do something else
137 if ( (! $identity) && $self->_identity_method) {
138 ($identity) = $self->_dbh->selectrow_array(
139 'select ' . $self->_identity_method
143 $self->_identity($identity);
147 return wantarray ? ($rv, $sth, @bind) : $rv;
150 sub last_insert_id { shift->_identity }
152 # savepoint syntax is the same as in Sybase ASE
155 my ($self, $name) = @_;
157 $self->_get_dbh->do("SAVE TRANSACTION $name");
160 # A new SAVE TRANSACTION with the same name releases the previous one.
161 sub _svp_release { 1 }
164 my ($self, $name) = @_;
166 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
169 sub build_datetime_parser {
171 my $type = "DateTime::Format::Strptime";
173 $self->throw_exception("Couldn't load ${type}: $@") if $@;
174 return $type->new( pattern => '%Y-%m-%d %H:%M:%S' ); # %F %T
177 sub sqlt_type { 'SQLServer' }
179 sub _sql_maker_opts {
180 my ( $self, $opts ) = @_;
183 $self->{_sql_maker_opts} = { %$opts };
186 return { limit_dialect => 'Top', %{$self->{_sql_maker_opts}||{}} };
193 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
198 This is the base class for Microsoft SQL Server support, used by
199 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
200 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
202 =head1 IMPLEMENTATION NOTES
204 =head2 IDENTITY information
206 Microsoft SQL Server supports three methods of retrieving the IDENTITY
207 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
208 SCOPE_IDENTITY is used here because it is the safest. However, it must
209 be called is the same execute statement, not just the same connection.
211 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
212 onto each INSERT to accommodate that requirement.
214 C<SELECT @@IDENTITY> can also be used by issuing:
216 $self->_identity_method('@@identity');
218 it will only be used if SCOPE_IDENTITY() fails.
220 This is more dangerous, as inserting into a table with an on insert trigger that
221 inserts into another table with an identity will give erroneous results on
222 recent versions of SQL Server.
226 Be aware that we have tried to make things as simple as possible for our users.
227 For MSSQL that means that when a user tries to do a populate/bulk_insert which
228 includes an autoincrementing column, we will try to tell the database to allow
229 the insertion of the autoinc column. But the user must have the db_ddladmin
230 role membership, otherwise you will get a fairly opaque error message.
234 See L<DBIx::Class/CONTRIBUTORS>.
238 You may distribute this code under the same terms as Perl itself.