I was wrong about 2d12a809 - the crash is real
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / MSSQL.pm
CommitLineData
75d07914 1package DBIx::Class::Storage::DBI::MSSQL;
3885cff6 2
75d07914 3use strict;
4use warnings;
3885cff6 5
fabbd5cc 6use base qw/
7 DBIx::Class::Storage::DBI::UniqueIdentifier
8 DBIx::Class::Storage::DBI::IdentityInsert
9/;
2ad62d97 10use mro 'c3';
fabbd5cc 11
ed7ab0f4 12use Try::Tiny;
6298a324 13use List::Util 'first';
fd323bf1 14use namespace::clean;
3885cff6 15
7b1b2582 16__PACKAGE__->mk_group_accessors(simple => qw/
25d3127d 17 _identity _identity_method _no_scope_identity_query
7b1b2582 18/);
19
d5dedbd6 20__PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL');
ac93965c 21
2b8cc2f2 22__PACKAGE__->sql_quote_char([qw/[ ]/]);
23
6f7a118e 24__PACKAGE__->datetime_parser_type (
25 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
26);
27
40d8d018 28__PACKAGE__->new_guid('NEWID()');
29
5a77aa8b 30sub _prep_for_execute {
31 my $self = shift;
0e773352 32 my ($op, $ident, $args) = @_;
5a77aa8b 33
34# cast MONEY values properly
35 if ($op eq 'insert' || $op eq 'update') {
36 my $fields = $args->[0];
5a77aa8b 37
52416317 38 my $colinfo = $ident->columns_info([keys %$fields]);
39
5a77aa8b 40 for my $col (keys %$fields) {
1537084d 41 # $ident is a result source object with INSERT/UPDATE ops
52416317 42 if (
43 $colinfo->{$col}{data_type}
44 &&
45 $colinfo->{$col}{data_type} =~ /^money\z/i
46 ) {
5a77aa8b 47 my $val = $fields->{$col};
48 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
49 }
50 }
51 }
52
53 my ($sql, $bind) = $self->next::method (@_);
54
fabbd5cc 55 # SELECT SCOPE_IDENTITY only works within a statement scope. We
56 # must try to always use this particular idiom frist, as it is the
57 # only one that guarantees retrieving the correct id under high
58 # concurrency. When this fails we will fall back to whatever secondary
59 # retrieval method is specified in _identity_method, but at this
60 # point we don't have many guarantees we will get what we expected.
61 # http://msdn.microsoft.com/en-us/library/ms190315.aspx
62 # http://davidhayden.com/blog/dave/archive/2006/01/17/2736.aspx
25d3127d 63 if ($self->_perform_autoinc_retrieval and not $self->_no_scope_identity_query) {
384b8bce 64 $sql .= "\nSELECT SCOPE_IDENTITY()";
5a77aa8b 65 }
66
67 return ($sql, $bind);
68}
69
70sub _execute {
71 my $self = shift;
72 my ($op) = @_;
73
fabbd5cc 74 # always list ctx - we need the $sth
0e773352 75 my ($rv, $sth, @bind) = $self->next::method(@_);
1537084d 76
fabbd5cc 77 if ($self->_perform_autoinc_retrieval) {
5a77aa8b 78
25d3127d 79 # attempt to bring back the result of SELECT SCOPE_IDENTITY() we tacked
1537084d 80 # on in _prep_for_execute above
25d3127d 81 my $identity;
82
83 # we didn't even try on ftds
84 unless ($self->_no_scope_identity_query) {
85 ($identity) = try { $sth->fetchrow_array };
86 $sth->finish;
87 }
ed8de058 88
1537084d 89 # SCOPE_IDENTITY failed, but we can do something else
90 if ( (! $identity) && $self->_identity_method) {
91 ($identity) = $self->_dbh->selectrow_array(
92 'select ' . $self->_identity_method
93 );
94 }
7b1b2582 95
1537084d 96 $self->_identity($identity);
7b1b2582 97 }
98
1537084d 99 return wantarray ? ($rv, $sth, @bind) : $rv;
7b1b2582 100}
5a77aa8b 101
7b1b2582 102sub last_insert_id { shift->_identity }
5a77aa8b 103
f0bd60fc 104#
e74c68ce 105# MSSQL is retarded wrt ordered subselects. One needs to add a TOP
6a247f33 106# to *all* subqueries, but one also *can't* use TOP 100 PERCENT
e74c68ce 107# http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
f0bd60fc 108#
109sub _select_args_to_query {
110 my $self = shift;
111
b8d88d9b 112 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
f0bd60fc 113
b8d88d9b 114 # see if this is an ordered subquery
115 my $attrs = $_[3];
aca481d8 116 if (
117 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
118 &&
bac358c9 119 scalar $self->_extract_order_criteria ($attrs->{order_by})
aca481d8 120 ) {
6de07ea3 121 $self->throw_exception(
d74f2da9 122 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
69a8b315 123 ') unless $attrs->{unsafe_subselect_ok};
e9657379 124 my $max = $self->sql_maker->__max_int;
e74c68ce 125 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
f0bd60fc 126 }
127
f0bd60fc 128 return wantarray
17555a0c 129 ? ($sql, $prep_bind, @rest)
130 : \[ "($sql)", @$prep_bind ]
f0bd60fc 131 ;
132}
133
134
4c0f4206 135# savepoint syntax is the same as in Sybase ASE
136
90d7422f 137sub _exec_svp_begin {
4c0f4206 138 my ($self, $name) = @_;
139
90d7422f 140 $self->_dbh->do("SAVE TRANSACTION $name");
4c0f4206 141}
142
143# A new SAVE TRANSACTION with the same name releases the previous one.
90d7422f 144sub _exec_svp_release { 1 }
4c0f4206 145
90d7422f 146sub _exec_svp_rollback {
4c0f4206 147 my ($self, $name) = @_;
148
90d7422f 149 $self->_dbh->do("ROLLBACK TRANSACTION $name");
4c0f4206 150}
151
eb0323df 152sub sqlt_type { 'SQLServer' }
153
6a247f33 154sub sql_limit_dialect {
50772633 155 my $self = shift;
eb0323df 156
6a247f33 157 my $supports_rno = 0;
ff153e24 158
6a247f33 159 if (exists $self->_server_info->{normalized_dbms_version}) {
160 $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
161 }
162 else {
163 # User is connecting via DBD::Sybase and has no permission to run
164 # stored procedures like xp_msver, or version detection failed for some
165 # other reason.
166 # So, we use a query to check if RNO is implemented.
167 try {
168 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
169 $supports_rno = 1;
170 };
50772633 171 }
e76e7b5c 172
6a247f33 173 return $supports_rno ? 'RowNumberOver' : 'Top';
ed8de058 174}
3885cff6 175
ecdf1ac8 176sub _ping {
177 my $self = shift;
178
179 my $dbh = $self->_dbh or return 0;
180
181 local $dbh->{RaiseError} = 1;
182 local $dbh->{PrintError} = 0;
183
52b420dd 184 return try {
ecdf1ac8 185 $dbh->do('select 1');
52b420dd 186 1;
ed7ab0f4 187 } catch {
52b420dd 188 0;
ecdf1ac8 189 };
ecdf1ac8 190}
191
fb95dc4d 192package # hide from PAUSE
193 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
194
fd323bf1 195my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
fb95dc4d 196my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
197
198my ($datetime_parser, $smalldatetime_parser);
199
200sub parse_datetime {
201 shift;
202 require DateTime::Format::Strptime;
203 $datetime_parser ||= DateTime::Format::Strptime->new(
204 pattern => $datetime_format,
205 on_error => 'croak',
206 );
207 return $datetime_parser->parse_datetime(shift);
208}
209
210sub format_datetime {
211 shift;
212 require DateTime::Format::Strptime;
213 $datetime_parser ||= DateTime::Format::Strptime->new(
214 pattern => $datetime_format,
215 on_error => 'croak',
216 );
217 return $datetime_parser->format_datetime(shift);
218}
219
220sub parse_smalldatetime {
221 shift;
222 require DateTime::Format::Strptime;
223 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
224 pattern => $smalldatetime_format,
225 on_error => 'croak',
226 );
227 return $smalldatetime_parser->parse_datetime(shift);
228}
229
230sub format_smalldatetime {
231 shift;
232 require DateTime::Format::Strptime;
233 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
234 pattern => $smalldatetime_format,
235 on_error => 'croak',
236 );
237 return $smalldatetime_parser->format_datetime(shift);
238}
239
75d07914 2401;
3885cff6 241
75d07914 242=head1 NAME
3885cff6 243
5a77aa8b 244DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
245in DBIx::Class
3885cff6 246
75d07914 247=head1 SYNOPSIS
3885cff6 248
5a77aa8b 249This is the base class for Microsoft SQL Server support, used by
250L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
251L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
eb0323df 252
5a77aa8b 253=head1 IMPLEMENTATION NOTES
eb0323df 254
fd05d10a 255=head2 IDENTITY information
256
5a77aa8b 257Microsoft SQL Server supports three methods of retrieving the IDENTITY
258value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
259SCOPE_IDENTITY is used here because it is the safest. However, it must
260be called is the same execute statement, not just the same connection.
eb0323df 261
5a77aa8b 262So, this implementation appends a SELECT SCOPE_IDENTITY() statement
263onto each INSERT to accommodate that requirement.
eb0323df 264
7b1b2582 265C<SELECT @@IDENTITY> can also be used by issuing:
266
267 $self->_identity_method('@@identity');
268
08cdc412 269it will only be used if SCOPE_IDENTITY() fails.
270
271This is more dangerous, as inserting into a table with an on insert trigger that
272inserts into another table with an identity will give erroneous results on
273recent versions of SQL Server.
7b1b2582 274
c84189e1 275=head2 identity insert
fd05d10a 276
277Be aware that we have tried to make things as simple as possible for our users.
c84189e1 278For MSSQL that means that when a user tries to create a row, while supplying an
279explicit value for an autoincrementing column, we will try to issue the
280appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
281$table_name ON>. Unfortunately this operation in MSSQL requires the
282C<db_ddladmin> privilege, which is normally not included in the standard
283write-permissions.
fd05d10a 284
d74f2da9 285=head2 Ordered Subselects
6de07ea3 286
d74f2da9 287If you attempted the following query (among many others) in Microsoft SQL
288Server
6de07ea3 289
6de07ea3 290 $rs->search ({}, {
6de07ea3 291 prefetch => 'relation',
292 rows => 2,
293 offset => 3,
294 });
295
d74f2da9 296You may be surprised to receive an exception. The reason for this is a quirk
297in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
298to the way DBIC is built. DBIC can do truly wonderful things with the aid of
299subselects, and does so automatically when necessary. The list of situations
300when a subselect is necessary is long and still changes often, so it can not
301be exhaustively enumerated here. The general rule of thumb is a joined
302L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
303applied to the left part of the join.
304
305In its "pursuit of standards" Microsft SQL Server goes to great lengths to
306forbid the use of ordered subselects. This breaks a very useful group of
307searches like "Give me things number 4 to 6 (ordered by name), and prefetch
308all their relations, no matter how many". While there is a hack which fools
309the syntax checker, the optimizer may B<still elect to break the subselect>.
310Testing has determined that while such breakage does occur (the test suite
311contains an explicit test which demonstrates the problem), it is relative
312rare. The benefits of ordered subselects are on the other hand too great to be
313outright disabled for MSSQL.
6de07ea3 314
315Thus compromise between usability and perfection is the MSSQL-specific
69a8b315 316L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
6de07ea3 317It is deliberately not possible to set this on the Storage level, as the user
48580715 318should inspect (and preferably regression-test) the return of every such
d74f2da9 319ResultSet individually. The example above would work if written like:
320
321 $rs->search ({}, {
69a8b315 322 unsafe_subselect_ok => 1,
d74f2da9 323 prefetch => 'relation',
324 rows => 2,
325 offset => 3,
326 });
6de07ea3 327
328If it is possible to rewrite the search() in a way that will avoid the need
329for this flag - you are urged to do so. If DBIC internals insist that an
d74f2da9 330ordered subselect is necessary for an operation, and you believe there is a
48580715 331different/better way to get the same result - please file a bugreport.
6de07ea3 332
5a77aa8b 333=head1 AUTHOR
3885cff6 334
548d1627 335See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
3885cff6 336
75d07914 337=head1 LICENSE
3885cff6 338
75d07914 339You may distribute this code under the same terms as Perl itself.
3885cff6 340
75d07914 341=cut