1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
11 __PACKAGE__->mk_group_accessors(simple => qw/
12 _identity _identity_method
15 __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
17 sub _set_identity_insert {
18 my ($self, $table) = @_;
21 'SET IDENTITY_INSERT %s ON',
22 $self->sql_maker->_quote ($table),
25 my $dbh = $self->_get_dbh;
26 eval { $dbh->do ($sql) };
28 $self->throw_exception (sprintf "Error executing '%s': %s",
35 sub _unset_identity_insert {
36 my ($self, $table) = @_;
39 'SET IDENTITY_INSERT %s OFF',
40 $self->sql_maker->_quote ($table),
43 my $dbh = $self->_get_dbh;
49 my ($source, $cols, $data) = @_;
51 my $is_identity_insert = (List::Util::first
52 { $source->column_info ($_)->{is_auto_increment} }
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 = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
79 if ($is_identity_insert) {
80 $self->_set_identity_insert ($source->name);
83 my $updated_cols = $self->next::method(@_);
85 if ($is_identity_insert) {
86 $self->_unset_identity_insert ($source->name);
92 sub _prep_for_execute {
94 my ($op, $extra_bind, $ident, $args) = @_;
96 # cast MONEY values properly
97 if ($op eq 'insert' || $op eq 'update') {
98 my $fields = $args->[0];
100 for my $col (keys %$fields) {
101 # $ident is a result source object with INSERT/UPDATE ops
102 if ($ident->column_info ($col)->{data_type}
104 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
105 my $val = $fields->{$col};
106 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
111 my ($sql, $bind) = $self->next::method (@_);
113 if ($op eq 'insert') {
114 $sql .= ';SELECT SCOPE_IDENTITY()';
118 return ($sql, $bind);
125 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
127 if ($op eq 'insert') {
129 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
130 # on in _prep_for_execute above
131 my ($identity) = eval { $sth->fetchrow_array };
133 # SCOPE_IDENTITY failed, but we can do something else
134 if ( (! $identity) && $self->_identity_method) {
135 ($identity) = $self->_dbh->selectrow_array(
136 'select ' . $self->_identity_method
140 $self->_identity($identity);
144 return wantarray ? ($rv, $sth, @bind) : $rv;
147 sub last_insert_id { shift->_identity }
150 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
151 # to *all* subqueries, but one also can't use TOP 100 PERCENT
152 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
154 sub _select_args_to_query {
157 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
159 # see if this is an ordered subquery
162 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
164 scalar $self->_parse_order_by ($attrs->{order_by})
166 $self->throw_exception(
167 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
168 ') unless $attrs->{unsafe_subselect_ok};
170 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
174 ? ($sql, $prep_bind, @rest)
175 : \[ "($sql)", @$prep_bind ]
180 # savepoint syntax is the same as in Sybase ASE
183 my ($self, $name) = @_;
185 $self->_get_dbh->do("SAVE TRANSACTION $name");
188 # A new SAVE TRANSACTION with the same name releases the previous one.
189 sub _svp_release { 1 }
192 my ($self, $name) = @_;
194 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
197 sub datetime_parser_type {
198 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
201 sub sqlt_type { 'SQLServer' }
206 unless ($self->_sql_maker) {
207 unless ($self->{_sql_maker_opts}{limit_dialect}) {
210 if (exists $self->_server_info->{normalized_dbms_version}) {
211 $have_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
214 # User is connecting via DBD::Sybase and has no permission to run
215 # stored procedures like xp_msver, or version detection failed for some
217 # So, we use a query to check if RNO is implemented.
218 $have_rno = 1 if (eval { local $@; ($self->_get_dbh
219 ->selectrow_array('SELECT row_number() OVER (ORDER BY rand())')
223 $self->{_sql_maker_opts} = {
224 limit_dialect => ($have_rno ? 'RowNumberOver' : 'Top'),
225 %{$self->{_sql_maker_opts}||{}}
229 my $maker = $self->next::method (@_);
232 return $self->_sql_maker;
238 my $dbh = $self->_dbh or return 0;
240 local $dbh->{RaiseError} = 1;
241 local $dbh->{PrintError} = 0;
244 $dbh->do('select 1');
250 package # hide from PAUSE
251 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
253 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
254 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
256 my ($datetime_parser, $smalldatetime_parser);
260 require DateTime::Format::Strptime;
261 $datetime_parser ||= DateTime::Format::Strptime->new(
262 pattern => $datetime_format,
265 return $datetime_parser->parse_datetime(shift);
268 sub format_datetime {
270 require DateTime::Format::Strptime;
271 $datetime_parser ||= DateTime::Format::Strptime->new(
272 pattern => $datetime_format,
275 return $datetime_parser->format_datetime(shift);
278 sub parse_smalldatetime {
280 require DateTime::Format::Strptime;
281 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
282 pattern => $smalldatetime_format,
285 return $smalldatetime_parser->parse_datetime(shift);
288 sub format_smalldatetime {
290 require DateTime::Format::Strptime;
291 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
292 pattern => $smalldatetime_format,
295 return $smalldatetime_parser->format_datetime(shift);
302 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
307 This is the base class for Microsoft SQL Server support, used by
308 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
309 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
311 =head1 IMPLEMENTATION NOTES
313 =head2 IDENTITY information
315 Microsoft SQL Server supports three methods of retrieving the IDENTITY
316 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
317 SCOPE_IDENTITY is used here because it is the safest. However, it must
318 be called is the same execute statement, not just the same connection.
320 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
321 onto each INSERT to accommodate that requirement.
323 C<SELECT @@IDENTITY> can also be used by issuing:
325 $self->_identity_method('@@identity');
327 it will only be used if SCOPE_IDENTITY() fails.
329 This is more dangerous, as inserting into a table with an on insert trigger that
330 inserts into another table with an identity will give erroneous results on
331 recent versions of SQL Server.
333 =head2 identity insert
335 Be aware that we have tried to make things as simple as possible for our users.
336 For MSSQL that means that when a user tries to create a row, while supplying an
337 explicit value for an autoincrementing column, we will try to issue the
338 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
339 $table_name ON>. Unfortunately this operation in MSSQL requires the
340 C<db_ddladmin> privilege, which is normally not included in the standard
343 =head2 Ordered Subselects
345 If you attempted the following query (among many others) in Microsoft SQL
349 prefetch => 'relation',
354 You may be surprised to receive an exception. The reason for this is a quirk
355 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
356 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
357 subselects, and does so automatically when necessary. The list of situations
358 when a subselect is necessary is long and still changes often, so it can not
359 be exhaustively enumerated here. The general rule of thumb is a joined
360 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
361 applied to the left part of the join.
363 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
364 forbid the use of ordered subselects. This breaks a very useful group of
365 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
366 all their relations, no matter how many". While there is a hack which fools
367 the syntax checker, the optimizer may B<still elect to break the subselect>.
368 Testing has determined that while such breakage does occur (the test suite
369 contains an explicit test which demonstrates the problem), it is relative
370 rare. The benefits of ordered subselects are on the other hand too great to be
371 outright disabled for MSSQL.
373 Thus compromise between usability and perfection is the MSSQL-specific
374 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
375 It is deliberately not possible to set this on the Storage level, as the user
376 should inspect (and preferably regression-test) the return of every such
377 ResultSet individually. The example above would work if written like:
380 unsafe_subselect_ok => 1,
381 prefetch => 'relation',
386 If it is possible to rewrite the search() in a way that will avoid the need
387 for this flag - you are urged to do so. If DBIC internals insist that an
388 ordered subselect is necessary for an operation, and you believe there is a
389 different/better way to get the same result - please file a bugreport.
393 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
397 You may distribute this code under the same terms as Perl itself.