1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/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",
35 sub _unset_identity_insert {
36 my ($self, $table) = @_;
39 'SET IDENTITY_INSERT %s OFF',
40 $self->sql_maker->_quote ($table),
43 my $dbh = $self->_get_dbh;
49 my ($source, $cols, $data) = @_;
51 my $is_identity_insert = (List::Util::first
52 { $source->column_info ($_)->{is_auto_increment} }
58 if ($is_identity_insert) {
59 $self->_set_identity_insert ($source->name);
62 $self->next::method(@_);
64 if ($is_identity_insert) {
65 $self->_unset_identity_insert ($source->name);
69 # support MSSQL GUID column types
73 my ($source, $to_insert) = @_;
75 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
78 my @pk_cols = $source->primary_columns;
80 @pk_cols{@pk_cols} = ();
83 $source->column_info($_)->{data_type}
85 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
88 my @auto_guids = grep {
89 $source->column_info($_)->{data_type}
91 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
93 $source->column_info($_)->{auto_nextval}
94 } grep { not exists $pk_cols{$_} } $source->columns;
97 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
99 my $updated_cols = {};
101 for my $guid_col (@get_guids_for) {
102 my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
103 $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
106 my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
110 if ($is_identity_insert) {
111 $self->_set_identity_insert ($source->name);
114 $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
116 if ($is_identity_insert) {
117 $self->_unset_identity_insert ($source->name);
121 return $updated_cols;
124 sub _prep_for_execute {
126 my ($op, $extra_bind, $ident, $args) = @_;
128 # cast MONEY values properly
129 if ($op eq 'insert' || $op eq 'update') {
130 my $fields = $args->[0];
132 for my $col (keys %$fields) {
133 # $ident is a result source object with INSERT/UPDATE ops
134 if ($ident->column_info ($col)->{data_type}
136 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
137 my $val = $fields->{$col};
138 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
143 my ($sql, $bind) = $self->next::method (@_);
145 if ($op eq 'insert') {
146 $sql .= ';SELECT SCOPE_IDENTITY()';
150 return ($sql, $bind);
157 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
159 if ($op eq 'insert') {
161 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
162 # on in _prep_for_execute above
163 my ($identity) = eval { $sth->fetchrow_array };
165 # SCOPE_IDENTITY failed, but we can do something else
166 if ( (! $identity) && $self->_identity_method) {
167 ($identity) = $self->_dbh->selectrow_array(
168 'select ' . $self->_identity_method
172 $self->_identity($identity);
176 return wantarray ? ($rv, $sth, @bind) : $rv;
179 sub last_insert_id { shift->_identity }
182 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
183 # to *all* subqueries, but one also can't use TOP 100 PERCENT
184 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
186 sub _select_args_to_query {
189 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
191 # see if this is an ordered subquery
193 if ( scalar $self->_parse_order_by ($attrs->{order_by}) ) {
194 $self->throw_exception(
195 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
196 ') unless $attrs->{unsafe_subselect_ok};
198 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
202 ? ($sql, $prep_bind, @rest)
203 : \[ "($sql)", @$prep_bind ]
208 # savepoint syntax is the same as in Sybase ASE
211 my ($self, $name) = @_;
213 $self->_get_dbh->do("SAVE TRANSACTION $name");
216 # A new SAVE TRANSACTION with the same name releases the previous one.
217 sub _svp_release { 1 }
220 my ($self, $name) = @_;
222 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
225 sub build_datetime_parser {
227 my $type = "DateTime::Format::Strptime";
229 $self->throw_exception("Couldn't load ${type}: $@") if $@;
230 return $type->new( pattern => '%Y-%m-%d %H:%M:%S' ); # %F %T
233 sub sqlt_type { 'SQLServer' }
238 unless ($self->_sql_maker) {
239 unless ($self->{_sql_maker_opts}{limit_dialect}) {
241 my ($version) = $self->_server_info->{dbms_ver} =~ /^(\d+)/;
244 $self->{_sql_maker_opts} = {
245 limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),
246 %{$self->{_sql_maker_opts}||{}}
250 my $maker = $self->next::method (@_);
253 return $self->_sql_maker;
259 my $dbh = $self->_dbh or return 0;
261 local $dbh->{RaiseError} = 1;
262 local $dbh->{PrintError} = 0;
265 $dbh->do('select 1');
275 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
280 This is the base class for Microsoft SQL Server support, used by
281 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
282 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
284 =head1 IMPLEMENTATION NOTES
286 =head2 IDENTITY information
288 Microsoft SQL Server supports three methods of retrieving the IDENTITY
289 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
290 SCOPE_IDENTITY is used here because it is the safest. However, it must
291 be called is the same execute statement, not just the same connection.
293 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
294 onto each INSERT to accommodate that requirement.
296 C<SELECT @@IDENTITY> can also be used by issuing:
298 $self->_identity_method('@@identity');
300 it will only be used if SCOPE_IDENTITY() fails.
302 This is more dangerous, as inserting into a table with an on insert trigger that
303 inserts into another table with an identity will give erroneous results on
304 recent versions of SQL Server.
306 =head2 identity insert
308 Be aware that we have tried to make things as simple as possible for our users.
309 For MSSQL that means that when a user tries to create a row, while supplying an
310 explicit value for an autoincrementing column, we will try to issue the
311 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
312 $table_name ON>. Unfortunately this operation in MSSQL requires the
313 C<db_ddladmin> privilege, which is normally not included in the standard
316 =head2 Ordered Subselects
318 If you attempted the following query (among many others) in Microsoft SQL
322 prefetch => 'relation',
327 You may be surprised to receive an exception. The reason for this is a quirk
328 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
329 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
330 subselects, and does so automatically when necessary. The list of situations
331 when a subselect is necessary is long and still changes often, so it can not
332 be exhaustively enumerated here. The general rule of thumb is a joined
333 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
334 applied to the left part of the join.
336 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
337 forbid the use of ordered subselects. This breaks a very useful group of
338 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
339 all their relations, no matter how many". While there is a hack which fools
340 the syntax checker, the optimizer may B<still elect to break the subselect>.
341 Testing has determined that while such breakage does occur (the test suite
342 contains an explicit test which demonstrates the problem), it is relative
343 rare. The benefits of ordered subselects are on the other hand too great to be
344 outright disabled for MSSQL.
346 Thus compromise between usability and perfection is the MSSQL-specific
347 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
348 It is deliberately not possible to set this on the Storage level, as the user
349 should inspect (and preferably regression-test) the return of every such
350 ResultSet individually. The example above would work if written like:
353 unsafe_subselect_ok => 1,
354 prefetch => 'relation',
359 If it is possible to rewrite the search() in a way that will avoid the need
360 for this flag - you are urged to do so. If DBIC internals insist that an
361 ordered subselect is necessary for an operation, and you believe there is a
362 different/better way to get the same result - please file a bugreport.
366 See L<DBIx::Class/CONTRIBUTORS>.
370 You may distribute this code under the same terms as Perl itself.