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
16 __PACKAGE__->sql_maker_class('DBIx::Class::SQLMaker::MSSQL');
18 sub _set_identity_insert {
19 my ($self, $table) = @_;
22 'SET IDENTITY_INSERT %s ON',
23 $self->sql_maker->_quote ($table),
26 my $dbh = $self->_get_dbh;
27 try { $dbh->do ($sql) }
29 $self->throw_exception (sprintf "Error executing '%s': %s",
36 sub _unset_identity_insert {
37 my ($self, $table) = @_;
40 'SET IDENTITY_INSERT %s OFF',
41 $self->sql_maker->_quote ($table),
44 my $dbh = $self->_get_dbh;
50 my ($source, $cols, $data) = @_;
52 my $is_identity_insert =
53 (first { $source->column_info ($_)->{is_auto_increment} } @{$cols}) ? 1 : 0;
55 if ($is_identity_insert) {
56 $self->_set_identity_insert ($source->name);
59 $self->next::method(@_);
61 if ($is_identity_insert) {
62 $self->_unset_identity_insert ($source->name);
68 my ($source, $to_insert) = @_;
70 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
72 my $is_identity_insert =
73 (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0;
75 if ($is_identity_insert) {
76 $self->_set_identity_insert ($source->name);
79 my $updated_cols = $self->next::method(@_);
81 if ($is_identity_insert) {
82 $self->_unset_identity_insert ($source->name);
88 sub _prep_for_execute {
90 my ($op, $extra_bind, $ident, $args) = @_;
92 # cast MONEY values properly
93 if ($op eq 'insert' || $op eq 'update') {
94 my $fields = $args->[0];
96 for my $col (keys %$fields) {
97 # $ident is a result source object with INSERT/UPDATE ops
98 if ($ident->column_info ($col)->{data_type}
100 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
101 my $val = $fields->{$col};
102 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
107 my ($sql, $bind) = $self->next::method (@_);
109 if ($op eq 'insert') {
110 $sql .= ';SELECT SCOPE_IDENTITY()';
114 return ($sql, $bind);
121 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
123 if ($op eq 'insert') {
125 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
126 # on in _prep_for_execute above
127 my ($identity) = try { $sth->fetchrow_array };
129 # SCOPE_IDENTITY failed, but we can do something else
130 if ( (! $identity) && $self->_identity_method) {
131 ($identity) = $self->_dbh->selectrow_array(
132 'select ' . $self->_identity_method
136 $self->_identity($identity);
140 return wantarray ? ($rv, $sth, @bind) : $rv;
143 sub last_insert_id { shift->_identity }
146 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
147 # to *all* subqueries, but one also *can't* use TOP 100 PERCENT
148 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
150 sub _select_args_to_query {
153 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
155 # see if this is an ordered subquery
158 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
160 scalar $self->_parse_order_by ($attrs->{order_by})
162 $self->throw_exception(
163 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
164 ') unless $attrs->{unsafe_subselect_ok};
165 my $max = $self->sql_maker->__max_int;
166 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
170 ? ($sql, $prep_bind, @rest)
171 : \[ "($sql)", @$prep_bind ]
176 # savepoint syntax is the same as in Sybase ASE
179 my ($self, $name) = @_;
181 $self->_get_dbh->do("SAVE TRANSACTION $name");
184 # A new SAVE TRANSACTION with the same name releases the previous one.
185 sub _svp_release { 1 }
188 my ($self, $name) = @_;
190 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
193 sub datetime_parser_type {
194 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
197 sub sqlt_type { 'SQLServer' }
199 sub sql_limit_dialect {
202 my $supports_rno = 0;
204 if (exists $self->_server_info->{normalized_dbms_version}) {
205 $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
208 # User is connecting via DBD::Sybase and has no permission to run
209 # stored procedures like xp_msver, or version detection failed for some
211 # So, we use a query to check if RNO is implemented.
213 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
218 return $supports_rno ? 'RowNumberOver' : 'Top';
224 my $dbh = $self->_dbh or return 0;
226 local $dbh->{RaiseError} = 1;
227 local $dbh->{PrintError} = 0;
230 $dbh->do('select 1');
237 package # hide from PAUSE
238 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
240 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
241 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
243 my ($datetime_parser, $smalldatetime_parser);
247 require DateTime::Format::Strptime;
248 $datetime_parser ||= DateTime::Format::Strptime->new(
249 pattern => $datetime_format,
252 return $datetime_parser->parse_datetime(shift);
255 sub format_datetime {
257 require DateTime::Format::Strptime;
258 $datetime_parser ||= DateTime::Format::Strptime->new(
259 pattern => $datetime_format,
262 return $datetime_parser->format_datetime(shift);
265 sub parse_smalldatetime {
267 require DateTime::Format::Strptime;
268 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
269 pattern => $smalldatetime_format,
272 return $smalldatetime_parser->parse_datetime(shift);
275 sub format_smalldatetime {
277 require DateTime::Format::Strptime;
278 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
279 pattern => $smalldatetime_format,
282 return $smalldatetime_parser->format_datetime(shift);
289 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
294 This is the base class for Microsoft SQL Server support, used by
295 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
296 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
298 =head1 IMPLEMENTATION NOTES
300 =head2 IDENTITY information
302 Microsoft SQL Server supports three methods of retrieving the IDENTITY
303 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
304 SCOPE_IDENTITY is used here because it is the safest. However, it must
305 be called is the same execute statement, not just the same connection.
307 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
308 onto each INSERT to accommodate that requirement.
310 C<SELECT @@IDENTITY> can also be used by issuing:
312 $self->_identity_method('@@identity');
314 it will only be used if SCOPE_IDENTITY() fails.
316 This is more dangerous, as inserting into a table with an on insert trigger that
317 inserts into another table with an identity will give erroneous results on
318 recent versions of SQL Server.
320 =head2 identity insert
322 Be aware that we have tried to make things as simple as possible for our users.
323 For MSSQL that means that when a user tries to create a row, while supplying an
324 explicit value for an autoincrementing column, we will try to issue the
325 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
326 $table_name ON>. Unfortunately this operation in MSSQL requires the
327 C<db_ddladmin> privilege, which is normally not included in the standard
330 =head2 Ordered Subselects
332 If you attempted the following query (among many others) in Microsoft SQL
336 prefetch => 'relation',
341 You may be surprised to receive an exception. The reason for this is a quirk
342 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
343 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
344 subselects, and does so automatically when necessary. The list of situations
345 when a subselect is necessary is long and still changes often, so it can not
346 be exhaustively enumerated here. The general rule of thumb is a joined
347 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
348 applied to the left part of the join.
350 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
351 forbid the use of ordered subselects. This breaks a very useful group of
352 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
353 all their relations, no matter how many". While there is a hack which fools
354 the syntax checker, the optimizer may B<still elect to break the subselect>.
355 Testing has determined that while such breakage does occur (the test suite
356 contains an explicit test which demonstrates the problem), it is relative
357 rare. The benefits of ordered subselects are on the other hand too great to be
358 outright disabled for MSSQL.
360 Thus compromise between usability and perfection is the MSSQL-specific
361 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
362 It is deliberately not possible to set this on the Storage level, as the user
363 should inspect (and preferably regression-test) the return of every such
364 ResultSet individually. The example above would work if written like:
367 unsafe_subselect_ok => 1,
368 prefetch => 'relation',
373 If it is possible to rewrite the search() in a way that will avoid the need
374 for this flag - you are urged to do so. If DBIC internals insist that an
375 ordered subselect is necessary for an operation, and you believe there is a
376 different/better way to get the same result - please file a bugreport.
380 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
384 You may distribute this code under the same terms as Perl itself.