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 __PACKAGE__->new_guid('NEWID()');
22 sub _set_identity_insert {
23 my ($self, $table) = @_;
25 my $stmt = 'SET IDENTITY_INSERT %s %s';
26 $table = $self->sql_maker->_quote($table);
28 $self->_pre_insert_sql (sprintf $stmt, $table, 'ON');
29 $self->_post_insert_sql(sprintf $stmt, $table, 'OFF');
34 my ($source, $cols, $data) = @_;
36 my $is_identity_insert =
37 (first { $_->{is_auto_increment} } values %{ $source->columns_info($cols) } )
42 if ($is_identity_insert) {
43 $self->_set_identity_insert ($source->name);
46 $self->next::method(@_);
51 my ($source, $to_insert) = @_;
53 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
55 my $is_identity_insert =
56 (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0;
58 if ($is_identity_insert) {
59 $self->_set_identity_insert ($source->name);
62 my $updated_cols = $self->next::method(@_);
67 sub _prep_for_execute {
69 my ($op, $extra_bind, $ident, $args) = @_;
71 # cast MONEY values properly
72 if ($op eq 'insert' || $op eq 'update') {
73 my $fields = $args->[0];
75 my $colinfo = $ident->columns_info([keys %$fields]);
77 for my $col (keys %$fields) {
78 # $ident is a result source object with INSERT/UPDATE ops
80 $colinfo->{$col}{data_type}
82 $colinfo->{$col}{data_type} =~ /^money\z/i
84 my $val = $fields->{$col};
85 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
90 my ($sql, $bind) = $self->next::method (@_);
92 if ($op eq 'insert') {
93 if (my $prepend = $self->_pre_insert_sql) {
94 $sql = "${prepend}\n${sql}";
95 $self->_pre_insert_sql(undef);
97 if (my $append = $self->_post_insert_sql) {
98 $sql = "${sql}\n${append}";
99 $self->_post_insert_sql(undef);
101 $sql .= "\nSELECT SCOPE_IDENTITY()";
104 return ($sql, $bind);
111 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
113 if ($op eq 'insert') {
115 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
116 # on in _prep_for_execute above
117 my ($identity) = try { $sth->fetchrow_array };
119 # SCOPE_IDENTITY failed, but we can do something else
120 if ( (! $identity) && $self->_identity_method) {
121 ($identity) = $self->_dbh->selectrow_array(
122 'select ' . $self->_identity_method
126 $self->_identity($identity);
130 return wantarray ? ($rv, $sth, @bind) : $rv;
133 sub last_insert_id { shift->_identity }
136 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
137 # to *all* subqueries, but one also *can't* use TOP 100 PERCENT
138 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
140 sub _select_args_to_query {
143 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
145 # see if this is an ordered subquery
148 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
150 scalar $self->_extract_order_criteria ($attrs->{order_by})
152 $self->throw_exception(
153 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
154 ') unless $attrs->{unsafe_subselect_ok};
155 my $max = $self->sql_maker->__max_int;
156 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
160 ? ($sql, $prep_bind, @rest)
161 : \[ "($sql)", @$prep_bind ]
166 # savepoint syntax is the same as in Sybase ASE
169 my ($self, $name) = @_;
171 $self->_get_dbh->do("SAVE TRANSACTION $name");
174 # A new SAVE TRANSACTION with the same name releases the previous one.
175 sub _svp_release { 1 }
178 my ($self, $name) = @_;
180 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
183 sub datetime_parser_type {
184 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
187 sub sqlt_type { 'SQLServer' }
189 sub sql_limit_dialect {
192 my $supports_rno = 0;
194 if (exists $self->_server_info->{normalized_dbms_version}) {
195 $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
198 # User is connecting via DBD::Sybase and has no permission to run
199 # stored procedures like xp_msver, or version detection failed for some
201 # So, we use a query to check if RNO is implemented.
203 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
208 return $supports_rno ? 'RowNumberOver' : 'Top';
214 my $dbh = $self->_dbh or return 0;
216 local $dbh->{RaiseError} = 1;
217 local $dbh->{PrintError} = 0;
220 $dbh->do('select 1');
227 package # hide from PAUSE
228 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
230 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
231 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
233 my ($datetime_parser, $smalldatetime_parser);
237 require DateTime::Format::Strptime;
238 $datetime_parser ||= DateTime::Format::Strptime->new(
239 pattern => $datetime_format,
242 return $datetime_parser->parse_datetime(shift);
245 sub format_datetime {
247 require DateTime::Format::Strptime;
248 $datetime_parser ||= DateTime::Format::Strptime->new(
249 pattern => $datetime_format,
252 return $datetime_parser->format_datetime(shift);
255 sub parse_smalldatetime {
257 require DateTime::Format::Strptime;
258 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
259 pattern => $smalldatetime_format,
262 return $smalldatetime_parser->parse_datetime(shift);
265 sub format_smalldatetime {
267 require DateTime::Format::Strptime;
268 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
269 pattern => $smalldatetime_format,
272 return $smalldatetime_parser->format_datetime(shift);
279 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
284 This is the base class for Microsoft SQL Server support, used by
285 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
286 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
288 =head1 IMPLEMENTATION NOTES
290 =head2 IDENTITY information
292 Microsoft SQL Server supports three methods of retrieving the IDENTITY
293 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
294 SCOPE_IDENTITY is used here because it is the safest. However, it must
295 be called is the same execute statement, not just the same connection.
297 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
298 onto each INSERT to accommodate that requirement.
300 C<SELECT @@IDENTITY> can also be used by issuing:
302 $self->_identity_method('@@identity');
304 it will only be used if SCOPE_IDENTITY() fails.
306 This is more dangerous, as inserting into a table with an on insert trigger that
307 inserts into another table with an identity will give erroneous results on
308 recent versions of SQL Server.
310 =head2 identity insert
312 Be aware that we have tried to make things as simple as possible for our users.
313 For MSSQL that means that when a user tries to create a row, while supplying an
314 explicit value for an autoincrementing column, we will try to issue the
315 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
316 $table_name ON>. Unfortunately this operation in MSSQL requires the
317 C<db_ddladmin> privilege, which is normally not included in the standard
320 =head2 Ordered Subselects
322 If you attempted the following query (among many others) in Microsoft SQL
326 prefetch => 'relation',
331 You may be surprised to receive an exception. The reason for this is a quirk
332 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
333 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
334 subselects, and does so automatically when necessary. The list of situations
335 when a subselect is necessary is long and still changes often, so it can not
336 be exhaustively enumerated here. The general rule of thumb is a joined
337 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
338 applied to the left part of the join.
340 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
341 forbid the use of ordered subselects. This breaks a very useful group of
342 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
343 all their relations, no matter how many". While there is a hack which fools
344 the syntax checker, the optimizer may B<still elect to break the subselect>.
345 Testing has determined that while such breakage does occur (the test suite
346 contains an explicit test which demonstrates the problem), it is relative
347 rare. The benefits of ordered subselects are on the other hand too great to be
348 outright disabled for MSSQL.
350 Thus compromise between usability and perfection is the MSSQL-specific
351 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
352 It is deliberately not possible to set this on the Storage level, as the user
353 should inspect (and preferably regression-test) the return of every such
354 ResultSet individually. The example above would work if written like:
357 unsafe_subselect_ok => 1,
358 prefetch => 'relation',
363 If it is possible to rewrite the search() in a way that will avoid the need
364 for this flag - you are urged to do so. If DBIC internals insist that an
365 ordered subselect is necessary for an operation, and you believe there is a
366 different/better way to get the same result - please file a bugreport.
370 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
374 You may distribute this code under the same terms as Perl itself.