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 { $_->{is_auto_increment} } values %{ $source->columns_info($cols) } )
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);
71 my ($source, $to_insert) = @_;
73 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
75 my $is_identity_insert =
76 (first { $_->{is_auto_increment} } values %$supplied_col_info) ? 1 : 0;
78 if ($is_identity_insert) {
79 $self->_set_identity_insert ($source->name);
82 my $updated_cols = $self->next::method(@_);
84 if ($is_identity_insert) {
85 $self->_unset_identity_insert ($source->name);
91 sub _prep_for_execute {
93 my ($op, $extra_bind, $ident, $args) = @_;
95 # cast MONEY values properly
96 if ($op eq 'insert' || $op eq 'update') {
97 my $fields = $args->[0];
99 my $colinfo = $ident->columns_info([keys %$fields]);
101 for my $col (keys %$fields) {
102 # $ident is a result source object with INSERT/UPDATE ops
104 $colinfo->{$col}{data_type}
106 $colinfo->{$col}{data_type} =~ /^money\z/i
108 my $val = $fields->{$col};
109 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
114 my ($sql, $bind) = $self->next::method (@_);
116 if ($op eq 'insert') {
117 $sql .= ';SELECT SCOPE_IDENTITY()';
121 return ($sql, $bind);
128 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
130 if ($op eq 'insert') {
132 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
133 # on in _prep_for_execute above
134 my ($identity) = try { $sth->fetchrow_array };
136 # SCOPE_IDENTITY failed, but we can do something else
137 if ( (! $identity) && $self->_identity_method) {
138 ($identity) = $self->_dbh->selectrow_array(
139 'select ' . $self->_identity_method
143 $self->_identity($identity);
147 return wantarray ? ($rv, $sth, @bind) : $rv;
150 sub last_insert_id { shift->_identity }
153 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
154 # to *all* subqueries, but one also *can't* use TOP 100 PERCENT
155 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
157 sub _select_args_to_query {
160 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
162 # see if this is an ordered subquery
165 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
167 scalar $self->_extract_order_criteria ($attrs->{order_by})
169 $self->throw_exception(
170 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
171 ') unless $attrs->{unsafe_subselect_ok};
172 my $max = $self->sql_maker->__max_int;
173 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
177 ? ($sql, $prep_bind, @rest)
178 : \[ "($sql)", @$prep_bind ]
183 # savepoint syntax is the same as in Sybase ASE
186 my ($self, $name) = @_;
188 $self->_get_dbh->do("SAVE TRANSACTION $name");
191 # A new SAVE TRANSACTION with the same name releases the previous one.
192 sub _svp_release { 1 }
195 my ($self, $name) = @_;
197 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
200 sub datetime_parser_type {
201 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
204 sub sqlt_type { 'SQLServer' }
206 sub sql_limit_dialect {
209 my $supports_rno = 0;
211 if (exists $self->_server_info->{normalized_dbms_version}) {
212 $supports_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
215 # User is connecting via DBD::Sybase and has no permission to run
216 # stored procedures like xp_msver, or version detection failed for some
218 # So, we use a query to check if RNO is implemented.
220 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
225 return $supports_rno ? 'RowNumberOver' : 'Top';
231 my $dbh = $self->_dbh or return 0;
233 local $dbh->{RaiseError} = 1;
234 local $dbh->{PrintError} = 0;
237 $dbh->do('select 1');
244 package # hide from PAUSE
245 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
247 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
248 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
250 my ($datetime_parser, $smalldatetime_parser);
254 require DateTime::Format::Strptime;
255 $datetime_parser ||= DateTime::Format::Strptime->new(
256 pattern => $datetime_format,
259 return $datetime_parser->parse_datetime(shift);
262 sub format_datetime {
264 require DateTime::Format::Strptime;
265 $datetime_parser ||= DateTime::Format::Strptime->new(
266 pattern => $datetime_format,
269 return $datetime_parser->format_datetime(shift);
272 sub parse_smalldatetime {
274 require DateTime::Format::Strptime;
275 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
276 pattern => $smalldatetime_format,
279 return $smalldatetime_parser->parse_datetime(shift);
282 sub format_smalldatetime {
284 require DateTime::Format::Strptime;
285 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
286 pattern => $smalldatetime_format,
289 return $smalldatetime_parser->format_datetime(shift);
296 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
301 This is the base class for Microsoft SQL Server support, used by
302 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
303 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
305 =head1 IMPLEMENTATION NOTES
307 =head2 IDENTITY information
309 Microsoft SQL Server supports three methods of retrieving the IDENTITY
310 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
311 SCOPE_IDENTITY is used here because it is the safest. However, it must
312 be called is the same execute statement, not just the same connection.
314 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
315 onto each INSERT to accommodate that requirement.
317 C<SELECT @@IDENTITY> can also be used by issuing:
319 $self->_identity_method('@@identity');
321 it will only be used if SCOPE_IDENTITY() fails.
323 This is more dangerous, as inserting into a table with an on insert trigger that
324 inserts into another table with an identity will give erroneous results on
325 recent versions of SQL Server.
327 =head2 identity insert
329 Be aware that we have tried to make things as simple as possible for our users.
330 For MSSQL that means that when a user tries to create a row, while supplying an
331 explicit value for an autoincrementing column, we will try to issue the
332 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
333 $table_name ON>. Unfortunately this operation in MSSQL requires the
334 C<db_ddladmin> privilege, which is normally not included in the standard
337 =head2 Ordered Subselects
339 If you attempted the following query (among many others) in Microsoft SQL
343 prefetch => 'relation',
348 You may be surprised to receive an exception. The reason for this is a quirk
349 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
350 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
351 subselects, and does so automatically when necessary. The list of situations
352 when a subselect is necessary is long and still changes often, so it can not
353 be exhaustively enumerated here. The general rule of thumb is a joined
354 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
355 applied to the left part of the join.
357 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
358 forbid the use of ordered subselects. This breaks a very useful group of
359 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
360 all their relations, no matter how many". While there is a hack which fools
361 the syntax checker, the optimizer may B<still elect to break the subselect>.
362 Testing has determined that while such breakage does occur (the test suite
363 contains an explicit test which demonstrates the problem), it is relative
364 rare. The benefits of ordered subselects are on the other hand too great to be
365 outright disabled for MSSQL.
367 Thus compromise between usability and perfection is the MSSQL-specific
368 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
369 It is deliberately not possible to set this on the Storage level, as the user
370 should inspect (and preferably regression-test) the return of every such
371 ResultSet individually. The example above would work if written like:
374 unsafe_subselect_ok => 1,
375 prefetch => 'relation',
380 If it is possible to rewrite the search() in a way that will avoid the need
381 for this flag - you are urged to do so. If DBIC internals insist that an
382 ordered subselect is necessary for an operation, and you believe there is a
383 different/better way to get the same result - please file a bugreport.
387 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
391 You may distribute this code under the same terms as Perl itself.