1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
9 use List::Util 'first';
12 __PACKAGE__->mk_group_accessors(simple => qw/
13 _identity _identity_method _pre_insert_sql _post_insert_sql
16 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL');
18 __PACKAGE__->sql_quote_char([qw/[ ]/]);
20 sub _set_identity_insert {
21 my ($self, $table) = @_;
23 my $stmt = 'SET IDENTITY_INSERT %s %s';
24 $table = $self->sql_maker->_quote($table);
26 $self->_pre_insert_sql (sprintf $stmt, $table, 'ON');
27 $self->_post_insert_sql(sprintf $stmt, $table, 'OFF');
32 my ($source, $cols, $data) = @_;
34 my $is_identity_insert =
35 (first { $_->{is_auto_increment} } values %{ $source->columns_info($cols) } )
40 if ($is_identity_insert) {
41 $self->_set_identity_insert ($source->name);
44 $self->next::method(@_);
49 my ($source, $to_insert) = @_;
51 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
53 my $is_identity_insert =
54 (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0;
56 if ($is_identity_insert) {
57 $self->_set_identity_insert ($source->name);
60 my $updated_cols = $self->next::method(@_);
65 sub _prep_for_execute {
67 my ($op, $extra_bind, $ident, $args) = @_;
69 # cast MONEY values properly
70 if ($op eq 'insert' || $op eq 'update') {
71 my $fields = $args->[0];
73 my $colinfo = $ident->columns_info([keys %$fields]);
75 for my $col (keys %$fields) {
76 # $ident is a result source object with INSERT/UPDATE ops
78 $colinfo->{$col}{data_type}
80 $colinfo->{$col}{data_type} =~ /^money\z/i
82 my $val = $fields->{$col};
83 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
88 my ($sql, $bind) = $self->next::method (@_);
90 if ($op eq 'insert') {
91 if (my $prepend = $self->_pre_insert_sql) {
92 $sql = "${prepend}\n${sql}";
93 $self->_pre_insert_sql(undef);
95 if (my $append = $self->_post_insert_sql) {
96 $sql = "${sql}\n${append}";
97 $self->_post_insert_sql(undef);
99 $sql .= "\nSELECT SCOPE_IDENTITY()";
102 return ($sql, $bind);
109 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
111 if ($op eq 'insert') {
113 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
114 # on in _prep_for_execute above
115 my ($identity) = try { $sth->fetchrow_array };
117 # SCOPE_IDENTITY failed, but we can do something else
118 if ( (! $identity) && $self->_identity_method) {
119 ($identity) = $self->_dbh->selectrow_array(
120 'select ' . $self->_identity_method
124 $self->_identity($identity);
128 return wantarray ? ($rv, $sth, @bind) : $rv;
131 sub last_insert_id { shift->_identity }
134 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
135 # to *all* subqueries, but one also *can't* use TOP 100 PERCENT
136 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
138 sub _select_args_to_query {
141 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
143 # see if this is an ordered subquery
146 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
148 scalar $self->_extract_order_criteria ($attrs->{order_by})
150 $self->throw_exception(
151 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
152 ') unless $attrs->{unsafe_subselect_ok};
153 my $max = $self->sql_maker->__max_int;
154 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
158 ? ($sql, $prep_bind, @rest)
159 : \[ "($sql)", @$prep_bind ]
164 # savepoint syntax is the same as in Sybase ASE
167 my ($self, $name) = @_;
169 $self->_get_dbh->do("SAVE TRANSACTION $name");
172 # A new SAVE TRANSACTION with the same name releases the previous one.
173 sub _svp_release { 1 }
176 my ($self, $name) = @_;
178 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
181 sub datetime_parser_type {
182 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
185 sub sqlt_type { 'SQLServer' }
187 sub sql_limit_dialect {
190 my $supports_rno = 0;
192 if (exists $self->_server_info->{normalized_dbms_version}) {
193 $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
196 # User is connecting via DBD::Sybase and has no permission to run
197 # stored procedures like xp_msver, or version detection failed for some
199 # So, we use a query to check if RNO is implemented.
201 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
206 return $supports_rno ? 'RowNumberOver' : 'Top';
212 my $dbh = $self->_dbh or return 0;
214 local $dbh->{RaiseError} = 1;
215 local $dbh->{PrintError} = 0;
218 $dbh->do('select 1');
225 package # hide from PAUSE
226 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
228 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
229 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
231 my ($datetime_parser, $smalldatetime_parser);
235 require DateTime::Format::Strptime;
236 $datetime_parser ||= DateTime::Format::Strptime->new(
237 pattern => $datetime_format,
240 return $datetime_parser->parse_datetime(shift);
243 sub format_datetime {
245 require DateTime::Format::Strptime;
246 $datetime_parser ||= DateTime::Format::Strptime->new(
247 pattern => $datetime_format,
250 return $datetime_parser->format_datetime(shift);
253 sub parse_smalldatetime {
255 require DateTime::Format::Strptime;
256 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
257 pattern => $smalldatetime_format,
260 return $smalldatetime_parser->parse_datetime(shift);
263 sub format_smalldatetime {
265 require DateTime::Format::Strptime;
266 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
267 pattern => $smalldatetime_format,
270 return $smalldatetime_parser->format_datetime(shift);
277 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
282 This is the base class for Microsoft SQL Server support, used by
283 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
284 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
286 =head1 IMPLEMENTATION NOTES
288 =head2 IDENTITY information
290 Microsoft SQL Server supports three methods of retrieving the IDENTITY
291 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
292 SCOPE_IDENTITY is used here because it is the safest. However, it must
293 be called is the same execute statement, not just the same connection.
295 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
296 onto each INSERT to accommodate that requirement.
298 C<SELECT @@IDENTITY> can also be used by issuing:
300 $self->_identity_method('@@identity');
302 it will only be used if SCOPE_IDENTITY() fails.
304 This is more dangerous, as inserting into a table with an on insert trigger that
305 inserts into another table with an identity will give erroneous results on
306 recent versions of SQL Server.
308 =head2 identity insert
310 Be aware that we have tried to make things as simple as possible for our users.
311 For MSSQL that means that when a user tries to create a row, while supplying an
312 explicit value for an autoincrementing column, we will try to issue the
313 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
314 $table_name ON>. Unfortunately this operation in MSSQL requires the
315 C<db_ddladmin> privilege, which is normally not included in the standard
318 =head2 Ordered Subselects
320 If you attempted the following query (among many others) in Microsoft SQL
324 prefetch => 'relation',
329 You may be surprised to receive an exception. The reason for this is a quirk
330 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
331 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
332 subselects, and does so automatically when necessary. The list of situations
333 when a subselect is necessary is long and still changes often, so it can not
334 be exhaustively enumerated here. The general rule of thumb is a joined
335 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
336 applied to the left part of the join.
338 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
339 forbid the use of ordered subselects. This breaks a very useful group of
340 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
341 all their relations, no matter how many". While there is a hack which fools
342 the syntax checker, the optimizer may B<still elect to break the subselect>.
343 Testing has determined that while such breakage does occur (the test suite
344 contains an explicit test which demonstrates the problem), it is relative
345 rare. The benefits of ordered subselects are on the other hand too great to be
346 outright disabled for MSSQL.
348 Thus compromise between usability and perfection is the MSSQL-specific
349 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
350 It is deliberately not possible to set this on the Storage level, as the user
351 should inspect (and preferably regression-test) the return of every such
352 ResultSet individually. The example above would work if written like:
355 unsafe_subselect_ok => 1,
356 prefetch => 'relation',
361 If it is possible to rewrite the search() in a way that will avoid the need
362 for this flag - you are urged to do so. If DBIC internals insist that an
363 ordered subselect is necessary for an operation, and you believe there is a
364 different/better way to get the same result - please file a bugreport.
368 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
372 You may distribute this code under the same terms as Perl itself.