1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/DBIx::Class::Storage::DBI::UniqueIdentifier/;
13 __PACKAGE__->mk_group_accessors(simple => qw/
14 _identity _identity_method
17 __PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
19 sub _set_identity_insert {
20 my ($self, $table) = @_;
23 'SET IDENTITY_INSERT %s ON',
24 $self->sql_maker->_quote ($table),
27 my $dbh = $self->_get_dbh;
28 try { $dbh->do ($sql) }
30 $self->throw_exception (sprintf "Error executing '%s': %s",
37 sub _unset_identity_insert {
38 my ($self, $table) = @_;
41 'SET IDENTITY_INSERT %s OFF',
42 $self->sql_maker->_quote ($table),
45 my $dbh = $self->_get_dbh;
51 my ($source, $cols, $data) = @_;
53 my $is_identity_insert = (List::Util::first
54 { $source->column_info ($_)->{is_auto_increment} }
60 if ($is_identity_insert) {
61 $self->_set_identity_insert ($source->name);
64 $self->next::method(@_);
66 if ($is_identity_insert) {
67 $self->_unset_identity_insert ($source->name);
73 my ($source, $to_insert) = @_;
75 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
77 my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
81 if ($is_identity_insert) {
82 $self->_set_identity_insert ($source->name);
85 my $updated_cols = $self->next::method(@_);
87 if ($is_identity_insert) {
88 $self->_unset_identity_insert ($source->name);
94 sub _prep_for_execute {
96 my ($op, $extra_bind, $ident, $args) = @_;
98 # cast MONEY values properly
99 if ($op eq 'insert' || $op eq 'update') {
100 my $fields = $args->[0];
102 for my $col (keys %$fields) {
103 # $ident is a result source object with INSERT/UPDATE ops
104 if ($ident->column_info ($col)->{data_type}
106 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
107 my $val = $fields->{$col};
108 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
113 my ($sql, $bind) = $self->next::method (@_);
115 if ($op eq 'insert') {
116 $sql .= ';SELECT SCOPE_IDENTITY()';
120 return ($sql, $bind);
127 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
129 if ($op eq 'insert') {
131 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
132 # on in _prep_for_execute above
133 my ($identity) = try { $sth->fetchrow_array };
135 # SCOPE_IDENTITY failed, but we can do something else
136 if ( (! $identity) && $self->_identity_method) {
137 ($identity) = $self->_dbh->selectrow_array(
138 'select ' . $self->_identity_method
142 $self->_identity($identity);
146 return wantarray ? ($rv, $sth, @bind) : $rv;
149 sub last_insert_id { shift->_identity }
152 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
153 # to *all* subqueries, but one also can't use TOP 100 PERCENT
154 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
156 sub _select_args_to_query {
159 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
161 # see if this is an ordered subquery
164 $sql !~ /^ \s* SELECT \s+ TOP \s+ \d+ \s+ /xi
166 scalar $self->_parse_order_by ($attrs->{order_by})
168 $self->throw_exception(
169 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
170 ') unless $attrs->{unsafe_subselect_ok};
172 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
176 ? ($sql, $prep_bind, @rest)
177 : \[ "($sql)", @$prep_bind ]
182 # savepoint syntax is the same as in Sybase ASE
185 my ($self, $name) = @_;
187 $self->_get_dbh->do("SAVE TRANSACTION $name");
190 # A new SAVE TRANSACTION with the same name releases the previous one.
191 sub _svp_release { 1 }
194 my ($self, $name) = @_;
196 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
199 sub datetime_parser_type {
200 'DBIx::Class::Storage::DBI::MSSQL::DateTime::Format'
203 sub sqlt_type { 'SQLServer' }
208 unless ($self->_sql_maker) {
209 unless ($self->{_sql_maker_opts}{limit_dialect}) {
212 if (exists $self->_server_info->{normalized_dbms_version}) {
213 $have_rno = 1 if $self->_server_info->{normalized_dbms_version} >= 9;
216 # User is connecting via DBD::Sybase and has no permission to run
217 # stored procedures like xp_msver, or version detection failed for some
219 # So, we use a query to check if RNO is implemented.
221 $self->_get_dbh->selectrow_array('SELECT row_number() OVER (ORDER BY rand())');
226 $self->{_sql_maker_opts} = {
227 limit_dialect => ($have_rno ? 'RowNumberOver' : 'Top'),
228 %{$self->{_sql_maker_opts}||{}}
232 my $maker = $self->next::method (@_);
235 return $self->_sql_maker;
241 my $dbh = $self->_dbh or return 0;
243 local $dbh->{RaiseError} = 1;
244 local $dbh->{PrintError} = 0;
247 $dbh->do('select 1');
254 package # hide from PAUSE
255 DBIx::Class::Storage::DBI::MSSQL::DateTime::Format;
257 my $datetime_format = '%Y-%m-%d %H:%M:%S.%3N'; # %F %T
258 my $smalldatetime_format = '%Y-%m-%d %H:%M:%S';
260 my ($datetime_parser, $smalldatetime_parser);
264 require DateTime::Format::Strptime;
265 $datetime_parser ||= DateTime::Format::Strptime->new(
266 pattern => $datetime_format,
269 return $datetime_parser->parse_datetime(shift);
272 sub format_datetime {
274 require DateTime::Format::Strptime;
275 $datetime_parser ||= DateTime::Format::Strptime->new(
276 pattern => $datetime_format,
279 return $datetime_parser->format_datetime(shift);
282 sub parse_smalldatetime {
284 require DateTime::Format::Strptime;
285 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
286 pattern => $smalldatetime_format,
289 return $smalldatetime_parser->parse_datetime(shift);
292 sub format_smalldatetime {
294 require DateTime::Format::Strptime;
295 $smalldatetime_parser ||= DateTime::Format::Strptime->new(
296 pattern => $smalldatetime_format,
299 return $smalldatetime_parser->format_datetime(shift);
306 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
311 This is the base class for Microsoft SQL Server support, used by
312 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
313 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
315 =head1 IMPLEMENTATION NOTES
317 =head2 IDENTITY information
319 Microsoft SQL Server supports three methods of retrieving the IDENTITY
320 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
321 SCOPE_IDENTITY is used here because it is the safest. However, it must
322 be called is the same execute statement, not just the same connection.
324 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
325 onto each INSERT to accommodate that requirement.
327 C<SELECT @@IDENTITY> can also be used by issuing:
329 $self->_identity_method('@@identity');
331 it will only be used if SCOPE_IDENTITY() fails.
333 This is more dangerous, as inserting into a table with an on insert trigger that
334 inserts into another table with an identity will give erroneous results on
335 recent versions of SQL Server.
337 =head2 identity insert
339 Be aware that we have tried to make things as simple as possible for our users.
340 For MSSQL that means that when a user tries to create a row, while supplying an
341 explicit value for an autoincrementing column, we will try to issue the
342 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
343 $table_name ON>. Unfortunately this operation in MSSQL requires the
344 C<db_ddladmin> privilege, which is normally not included in the standard
347 =head2 Ordered Subselects
349 If you attempted the following query (among many others) in Microsoft SQL
353 prefetch => 'relation',
358 You may be surprised to receive an exception. The reason for this is a quirk
359 in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
360 to the way DBIC is built. DBIC can do truly wonderful things with the aid of
361 subselects, and does so automatically when necessary. The list of situations
362 when a subselect is necessary is long and still changes often, so it can not
363 be exhaustively enumerated here. The general rule of thumb is a joined
364 L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
365 applied to the left part of the join.
367 In its "pursuit of standards" Microsft SQL Server goes to great lengths to
368 forbid the use of ordered subselects. This breaks a very useful group of
369 searches like "Give me things number 4 to 6 (ordered by name), and prefetch
370 all their relations, no matter how many". While there is a hack which fools
371 the syntax checker, the optimizer may B<still elect to break the subselect>.
372 Testing has determined that while such breakage does occur (the test suite
373 contains an explicit test which demonstrates the problem), it is relative
374 rare. The benefits of ordered subselects are on the other hand too great to be
375 outright disabled for MSSQL.
377 Thus compromise between usability and perfection is the MSSQL-specific
378 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
379 It is deliberately not possible to set this on the Storage level, as the user
380 should inspect (and preferably regression-test) the return of every such
381 ResultSet individually. The example above would work if written like:
384 unsafe_subselect_ok => 1,
385 prefetch => 'relation',
390 If it is possible to rewrite the search() in a way that will avoid the need
391 for this flag - you are urged to do so. If DBIC internals insist that an
392 ordered subselect is necessary for an operation, and you believe there is a
393 different/better way to get the same result - please file a bugreport.
397 See L<DBIx::Class/AUTHOR> and L<DBIx::Class/CONTRIBUTORS>.
401 You may distribute this code under the same terms as Perl itself.