1 package DBIx::Class::Storage::DBI::MSSQL;
6 use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
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);
69 # support MSSQL GUID column types
73 my ($source, $to_insert) = @_;
75 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
78 my @pk_cols = $source->primary_columns;
80 @pk_cols{@pk_cols} = ();
83 $source->column_info($_)->{data_type}
85 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
88 my @auto_guids = grep {
89 $source->column_info($_)->{data_type}
91 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
93 $source->column_info($_)->{auto_nextval}
94 } grep { not exists $pk_cols{$_} } $source->columns;
97 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
99 my $updated_cols = {};
101 for my $guid_col (@get_guids_for) {
102 my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
103 $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
106 my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
110 if ($is_identity_insert) {
111 $self->_set_identity_insert ($source->name);
114 $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
116 if ($is_identity_insert) {
117 $self->_unset_identity_insert ($source->name);
121 return $updated_cols;
124 sub _prep_for_execute {
126 my ($op, $extra_bind, $ident, $args) = @_;
128 # cast MONEY values properly
129 if ($op eq 'insert' || $op eq 'update') {
130 my $fields = $args->[0];
132 for my $col (keys %$fields) {
133 # $ident is a result source object with INSERT/UPDATE ops
134 if ($ident->column_info ($col)->{data_type}
136 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
137 my $val = $fields->{$col};
138 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
143 my ($sql, $bind) = $self->next::method (@_);
145 if ($op eq 'insert') {
146 $sql .= ';SELECT SCOPE_IDENTITY()';
150 return ($sql, $bind);
157 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
159 if ($op eq 'insert') {
161 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
162 # on in _prep_for_execute above
163 my ($identity) = eval { $sth->fetchrow_array };
165 # SCOPE_IDENTITY failed, but we can do something else
166 if ( (! $identity) && $self->_identity_method) {
167 ($identity) = $self->_dbh->selectrow_array(
168 'select ' . $self->_identity_method
172 $self->_identity($identity);
176 return wantarray ? ($rv, $sth, @bind) : $rv;
179 sub last_insert_id { shift->_identity }
182 # MSSQL is retarded wrt ordered subselects. One needs to add a TOP
183 # to *all* subqueries, but one also can't use TOP 100 PERCENT
184 # http://sqladvice.com/forums/permalink/18496/22931/ShowThread.aspx#22931
186 sub _select_args_to_query {
189 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
191 # see if this is an ordered subquery
193 if ( scalar $self->sql_maker->_order_by_chunks ($attrs->{order_by}) ) {
194 $self->throw_exception(
195 'An ordered subquery encountered. Please see "Ordered Subqueries" in DBIx::Class::Storage::DBI::MSSQL
196 ') unless $attrs->{unsafe_subquery};
198 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
202 ? ($sql, $prep_bind, @rest)
203 : \[ "($sql)", @$prep_bind ]
208 # savepoint syntax is the same as in Sybase ASE
211 my ($self, $name) = @_;
213 $self->_get_dbh->do("SAVE TRANSACTION $name");
216 # A new SAVE TRANSACTION with the same name releases the previous one.
217 sub _svp_release { 1 }
220 my ($self, $name) = @_;
222 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
225 sub build_datetime_parser {
227 my $type = "DateTime::Format::Strptime";
229 $self->throw_exception("Couldn't load ${type}: $@") if $@;
230 return $type->new( pattern => '%Y-%m-%d %H:%M:%S' ); # %F %T
233 sub sqlt_type { 'SQLServer' }
235 sub _get_mssql_version {
238 my $data = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion');
240 if ($data->{Character_Value} =~ /^(\d+)\./) {
243 $self->throw_exception(q{Your ProductVersion's Character_Value is missing or malformed!});
250 unless ($self->_sql_maker) {
251 unless ($self->{_sql_maker_opts}{limit_dialect}) {
252 my $version = eval { $self->_get_mssql_version; } || 0;
254 $self->{_sql_maker_opts} = {
255 limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),
256 %{$self->{_sql_maker_opts}||{}}
260 my $maker = $self->next::method (@_);
263 return $self->_sql_maker;
270 DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
275 This is the base class for Microsoft SQL Server support, used by
276 L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
277 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
279 =head1 IMPLEMENTATION NOTES
281 =head2 IDENTITY information
283 Microsoft SQL Server supports three methods of retrieving the IDENTITY
284 value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
285 SCOPE_IDENTITY is used here because it is the safest. However, it must
286 be called is the same execute statement, not just the same connection.
288 So, this implementation appends a SELECT SCOPE_IDENTITY() statement
289 onto each INSERT to accommodate that requirement.
291 C<SELECT @@IDENTITY> can also be used by issuing:
293 $self->_identity_method('@@identity');
295 it will only be used if SCOPE_IDENTITY() fails.
297 This is more dangerous, as inserting into a table with an on insert trigger that
298 inserts into another table with an identity will give erroneous results on
299 recent versions of SQL Server.
301 =head2 identity insert
303 Be aware that we have tried to make things as simple as possible for our users.
304 For MSSQL that means that when a user tries to create a row, while supplying an
305 explicit value for an autoincrementing column, we will try to issue the
306 appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
307 $table_name ON>. Unfortunately this operation in MSSQL requires the
308 C<db_ddladmin> privilege, which is normally not included in the standard
311 =head2 Ordered Subqueries
313 # this is deemed unsafe and throws under MSSQL
315 prefetch => 'relation',
320 # however this should work (but please check what comes back from the db)
322 unsafe_subquery => 1,
323 prefetch => 'relation',
328 DBIC can do truly wonderful things with the aid of subqueries, and does so
329 automatically when necessary. Especially useful are ordered subqueries,
330 which allow things like "Give me things number 4 to 6 (ordered by name), and
331 prefetch all their relationss, no matter how many". In its pursuit of standards
332 Microsft SQL Server goes to great lengths to forbid the use of ordered
333 subqueries. While there is a hack which fools the syntax checker, the optimizer
334 may B<still elect to break the subquery>. Testing has determined that while
335 such breakage does occur (the test suite contains an explicit test which
336 demonstrates the problem), it is relative rare. The benefits of ordered
337 subqueries are on the other hand too great to be outright disabled for MSSQL.
339 Thus compromise between usability and perfection is the MSSQL-specific
340 L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subquery>.
341 It is deliberately not possible to set this on the Storage level, as the user
342 should inspect (and preferrably regression-test) the return of every such
343 ResultSet individually.
345 If it is possible to rewrite the search() in a way that will avoid the need
346 for this flag - you are urged to do so. If DBIC internals insist that an
347 ordered subquery is necessary for an operation, and you believe there is a
348 differnt way to express the query - please file a bugreport.
352 See L<DBIx::Class/CONTRIBUTORS>.
356 You may distribute this code under the same terms as Perl itself.