spelling fixes in the documaentation, sholud be gud now ;)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / MSSQL.pm
CommitLineData
75d07914 1package DBIx::Class::Storage::DBI::MSSQL;
3885cff6 2
75d07914 3use strict;
4use warnings;
3885cff6 5
48fe9087 6use base qw/DBIx::Class::Storage::DBI::AmbiguousGlob DBIx::Class::Storage::DBI/;
2ad62d97 7use mro 'c3';
3885cff6 8
5a77aa8b 9use List::Util();
10
7b1b2582 11__PACKAGE__->mk_group_accessors(simple => qw/
12 _identity _identity_method
13/);
14
ac93965c 15__PACKAGE__->sql_maker_class('DBIx::Class::SQLAHacks::MSSQL');
16
afcfff01 17sub _set_identity_insert {
18 my ($self, $table) = @_;
64690266 19
20 my $sql = sprintf (
afcfff01 21 'SET IDENTITY_INSERT %s ON',
64690266 22 $self->sql_maker->_quote ($table),
afcfff01 23 );
64690266 24
25 my $dbh = $self->_get_dbh;
26 eval { $dbh->do ($sql) };
27 if ($@) {
28 $self->throw_exception (sprintf "Error executing '%s': %s",
29 $sql,
30 $dbh->errstr,
31 );
32 }
afcfff01 33}
34
aac1a358 35sub _unset_identity_insert {
36 my ($self, $table) = @_;
37
38 my $sql = sprintf (
39 'SET IDENTITY_INSERT %s OFF',
40 $self->sql_maker->_quote ($table),
41 );
42
43 my $dbh = $self->_get_dbh;
44 $dbh->do ($sql);
45}
46
5a77aa8b 47sub insert_bulk {
48 my $self = shift;
49 my ($source, $cols, $data) = @_;
50
aac1a358 51 my $is_identity_insert = (List::Util::first
afcfff01 52 { $source->column_info ($_)->{is_auto_increment} }
53 (@{$cols})
aac1a358 54 )
55 ? 1
56 : 0;
5a77aa8b 57
aac1a358 58 if ($is_identity_insert) {
59 $self->_set_identity_insert ($source->name);
5a77aa8b 60 }
61
62 $self->next::method(@_);
63
aac1a358 64 if ($is_identity_insert) {
65 $self->_unset_identity_insert ($source->name);
5a77aa8b 66 }
67}
68
57ee81d0 69# support MSSQL GUID column types
70
ca791b95 71sub insert {
72 my $self = shift;
73 my ($source, $to_insert) = @_;
74
afcfff01 75 my $supplied_col_info = $self->_resolve_column_info($source, [keys %$to_insert] );
ca791b95 76
77 my %guid_cols;
78 my @pk_cols = $source->primary_columns;
79 my %pk_cols;
80 @pk_cols{@pk_cols} = ();
81
82 my @pk_guids = grep {
be294d66 83 $source->column_info($_)->{data_type}
84 &&
ca791b95 85 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
86 } @pk_cols;
87
88 my @auto_guids = grep {
be294d66 89 $source->column_info($_)->{data_type}
90 &&
ca791b95 91 $source->column_info($_)->{data_type} =~ /^uniqueidentifier/i
92 &&
93 $source->column_info($_)->{auto_nextval}
94 } grep { not exists $pk_cols{$_} } $source->columns;
95
96 my @get_guids_for =
97 grep { not exists $to_insert->{$_} } (@pk_guids, @auto_guids);
98
afcfff01 99 my $updated_cols = {};
100
ca791b95 101 for my $guid_col (@get_guids_for) {
9ae966b9 102 my ($new_guid) = $self->_get_dbh->selectrow_array('SELECT NEWID()');
ca791b95 103 $updated_cols->{$guid_col} = $to_insert->{$guid_col} = $new_guid;
104 }
105
aac1a358 106 my $is_identity_insert = (List::Util::first { $_->{is_auto_increment} } (values %$supplied_col_info) )
107 ? 1
108 : 0;
109
110 if ($is_identity_insert) {
111 $self->_set_identity_insert ($source->name);
afcfff01 112 }
113
ca791b95 114 $updated_cols = { %$updated_cols, %{ $self->next::method(@_) } };
115
aac1a358 116 if ($is_identity_insert) {
117 $self->_unset_identity_insert ($source->name);
118 }
119
120
ca791b95 121 return $updated_cols;
122}
123
5a77aa8b 124sub _prep_for_execute {
125 my $self = shift;
126 my ($op, $extra_bind, $ident, $args) = @_;
127
128# cast MONEY values properly
129 if ($op eq 'insert' || $op eq 'update') {
130 my $fields = $args->[0];
5a77aa8b 131
132 for my $col (keys %$fields) {
1537084d 133 # $ident is a result source object with INSERT/UPDATE ops
be294d66 134 if ($ident->column_info ($col)->{data_type}
135 &&
136 $ident->column_info ($col)->{data_type} =~ /^money\z/i) {
5a77aa8b 137 my $val = $fields->{$col};
138 $fields->{$col} = \['CAST(? AS MONEY)', [ $col => $val ]];
139 }
140 }
141 }
142
143 my ($sql, $bind) = $self->next::method (@_);
144
145 if ($op eq 'insert') {
146 $sql .= ';SELECT SCOPE_IDENTITY()';
147
5a77aa8b 148 }
149
150 return ($sql, $bind);
151}
152
153sub _execute {
154 my $self = shift;
155 my ($op) = @_;
156
157 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
1537084d 158
5a77aa8b 159 if ($op eq 'insert') {
5a77aa8b 160
1537084d 161 # this should bring back the result of SELECT SCOPE_IDENTITY() we tacked
162 # on in _prep_for_execute above
4ffa5700 163 my ($identity) = eval { $sth->fetchrow_array };
ed8de058 164
1537084d 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
169 );
170 }
7b1b2582 171
1537084d 172 $self->_identity($identity);
173 $sth->finish;
7b1b2582 174 }
175
1537084d 176 return wantarray ? ($rv, $sth, @bind) : $rv;
7b1b2582 177}
5a77aa8b 178
7b1b2582 179sub last_insert_id { shift->_identity }
5a77aa8b 180
f0bd60fc 181#
e74c68ce 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
f0bd60fc 185#
186sub _select_args_to_query {
187 my $self = shift;
188
b8d88d9b 189 my ($sql, $prep_bind, @rest) = $self->next::method (@_);
f0bd60fc 190
b8d88d9b 191 # see if this is an ordered subquery
192 my $attrs = $_[3];
c0748280 193 if ( scalar $self->_parse_order_by ($attrs->{order_by}) ) {
6de07ea3 194 $self->throw_exception(
d74f2da9 195 'An ordered subselect encountered - this is not safe! Please see "Ordered Subselects" in DBIx::Class::Storage::DBI::MSSQL
69a8b315 196 ') unless $attrs->{unsafe_subselect_ok};
e74c68ce 197 my $max = 2 ** 32;
198 $sql =~ s/^ \s* SELECT \s/SELECT TOP $max /xi;
f0bd60fc 199 }
200
f0bd60fc 201 return wantarray
17555a0c 202 ? ($sql, $prep_bind, @rest)
203 : \[ "($sql)", @$prep_bind ]
f0bd60fc 204 ;
205}
206
207
4c0f4206 208# savepoint syntax is the same as in Sybase ASE
209
210sub _svp_begin {
211 my ($self, $name) = @_;
212
9ae966b9 213 $self->_get_dbh->do("SAVE TRANSACTION $name");
4c0f4206 214}
215
216# A new SAVE TRANSACTION with the same name releases the previous one.
217sub _svp_release { 1 }
218
219sub _svp_rollback {
220 my ($self, $name) = @_;
221
9ae966b9 222 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
4c0f4206 223}
224
ed8de058 225sub build_datetime_parser {
226 my $self = shift;
227 my $type = "DateTime::Format::Strptime";
228 eval "use ${type}";
229 $self->throw_exception("Couldn't load ${type}: $@") if $@;
eb0323df 230 return $type->new( pattern => '%Y-%m-%d %H:%M:%S' ); # %F %T
231}
232
233sub sqlt_type { 'SQLServer' }
234
e76e7b5c 235sub _get_mssql_version {
236 my $self = shift;
237
238 my $data = $self->_get_dbh->selectrow_hashref('xp_msver ProductVersion');
239
240 if ($data->{Character_Value} =~ /^(\d+)\./) {
241 return $1;
242 } else {
50772633 243 $self->throw_exception(q{Your ProductVersion's Character_Value is missing or malformed!});
e76e7b5c 244 }
245}
246
50772633 247sub sql_maker {
248 my $self = shift;
eb0323df 249
50772633 250 unless ($self->_sql_maker) {
251 unless ($self->{_sql_maker_opts}{limit_dialect}) {
097c5167 252 my $version = eval { $self->_get_mssql_version; } || 0;
eb0323df 253
50772633 254 $self->{_sql_maker_opts} = {
255 limit_dialect => ($version >= 9 ? 'RowNumberOver' : 'Top'),
256 %{$self->{_sql_maker_opts}||{}}
257 };
258 }
259
260 my $maker = $self->next::method (@_);
261 }
e76e7b5c 262
50772633 263 return $self->_sql_maker;
ed8de058 264}
3885cff6 265
75d07914 2661;
3885cff6 267
75d07914 268=head1 NAME
3885cff6 269
5a77aa8b 270DBIx::Class::Storage::DBI::MSSQL - Base Class for Microsoft SQL Server support
271in DBIx::Class
3885cff6 272
75d07914 273=head1 SYNOPSIS
3885cff6 274
5a77aa8b 275This is the base class for Microsoft SQL Server support, used by
276L<DBIx::Class::Storage::DBI::ODBC::Microsoft_SQL_Server> and
277L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
eb0323df 278
5a77aa8b 279=head1 IMPLEMENTATION NOTES
eb0323df 280
fd05d10a 281=head2 IDENTITY information
282
5a77aa8b 283Microsoft SQL Server supports three methods of retrieving the IDENTITY
284value for inserted row: IDENT_CURRENT, @@IDENTITY, and SCOPE_IDENTITY().
285SCOPE_IDENTITY is used here because it is the safest. However, it must
286be called is the same execute statement, not just the same connection.
eb0323df 287
5a77aa8b 288So, this implementation appends a SELECT SCOPE_IDENTITY() statement
289onto each INSERT to accommodate that requirement.
eb0323df 290
7b1b2582 291C<SELECT @@IDENTITY> can also be used by issuing:
292
293 $self->_identity_method('@@identity');
294
08cdc412 295it will only be used if SCOPE_IDENTITY() fails.
296
297This is more dangerous, as inserting into a table with an on insert trigger that
298inserts into another table with an identity will give erroneous results on
299recent versions of SQL Server.
7b1b2582 300
c84189e1 301=head2 identity insert
fd05d10a 302
303Be aware that we have tried to make things as simple as possible for our users.
c84189e1 304For MSSQL that means that when a user tries to create a row, while supplying an
305explicit value for an autoincrementing column, we will try to issue the
306appropriate database call to make this possible, namely C<SET IDENTITY_INSERT
307$table_name ON>. Unfortunately this operation in MSSQL requires the
308C<db_ddladmin> privilege, which is normally not included in the standard
309write-permissions.
fd05d10a 310
d74f2da9 311=head2 Ordered Subselects
6de07ea3 312
d74f2da9 313If you attempted the following query (among many others) in Microsoft SQL
314Server
6de07ea3 315
6de07ea3 316 $rs->search ({}, {
6de07ea3 317 prefetch => 'relation',
318 rows => 2,
319 offset => 3,
320 });
321
d74f2da9 322You may be surprised to receive an exception. The reason for this is a quirk
323in the MSSQL engine itself, and sadly doesn't have a sensible workaround due
324to the way DBIC is built. DBIC can do truly wonderful things with the aid of
325subselects, and does so automatically when necessary. The list of situations
326when a subselect is necessary is long and still changes often, so it can not
327be exhaustively enumerated here. The general rule of thumb is a joined
328L<has_many|DBIx::Class::Relationship/has_many> relationship with limit/group
329applied to the left part of the join.
330
331In its "pursuit of standards" Microsft SQL Server goes to great lengths to
332forbid the use of ordered subselects. This breaks a very useful group of
333searches like "Give me things number 4 to 6 (ordered by name), and prefetch
334all their relations, no matter how many". While there is a hack which fools
335the syntax checker, the optimizer may B<still elect to break the subselect>.
336Testing has determined that while such breakage does occur (the test suite
337contains an explicit test which demonstrates the problem), it is relative
338rare. The benefits of ordered subselects are on the other hand too great to be
339outright disabled for MSSQL.
6de07ea3 340
341Thus compromise between usability and perfection is the MSSQL-specific
69a8b315 342L<resultset attribute|DBIx::Class::ResultSet/ATTRIBUTES> C<unsafe_subselect_ok>.
6de07ea3 343It is deliberately not possible to set this on the Storage level, as the user
48580715 344should inspect (and preferably regression-test) the return of every such
d74f2da9 345ResultSet individually. The example above would work if written like:
346
347 $rs->search ({}, {
69a8b315 348 unsafe_subselect_ok => 1,
d74f2da9 349 prefetch => 'relation',
350 rows => 2,
351 offset => 3,
352 });
6de07ea3 353
354If it is possible to rewrite the search() in a way that will avoid the need
355for this flag - you are urged to do so. If DBIC internals insist that an
d74f2da9 356ordered subselect is necessary for an operation, and you believe there is a
48580715 357different/better way to get the same result - please file a bugreport.
6de07ea3 358
5a77aa8b 359=head1 AUTHOR
3885cff6 360
5a77aa8b 361See L<DBIx::Class/CONTRIBUTORS>.
3885cff6 362
75d07914 363=head1 LICENSE
3885cff6 364
75d07914 365You may distribute this code under the same terms as Perl itself.
3885cff6 366
75d07914 367=cut