Commit | Line | Data |
4ffa5700 |
1 | package DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server; |
2 | |
3 | use strict; |
4 | use warnings; |
5 | |
6 | use base qw/ |
7 | DBIx::Class::Storage::DBI::ADO |
8 | DBIx::Class::Storage::DBI::MSSQL |
9 | /; |
10 | use mro 'c3'; |
616ca57f |
11 | |
2edf3352 |
12 | use DBIx::Class::Carp; |
13 | use DBIx::Class::Storage::DBI::ADO::CursorUtils qw/_normalize_guids _strip_trailing_binary_nulls/; |
616ca57f |
14 | use DBIx::Class::ResultSource::FromSpec::Util 'fromspec_columns_info'; |
2edf3352 |
15 | use namespace::clean; |
16 | |
17 | __PACKAGE__->cursor_class( |
18 | 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor' |
19 | ); |
20 | |
21 | __PACKAGE__->datetime_parser_type ( |
22 | 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format' |
23 | ); |
24 | |
25 | __PACKAGE__->new_guid(sub { |
26 | my $self = shift; |
27 | my $guid = $self->_get_dbh->selectrow_array('SELECT NEWID()'); |
28 | $guid =~ s/\A \{ (.+) \} \z/$1/xs; |
29 | return $guid; |
30 | }); |
4ffa5700 |
31 | |
56dca25f |
32 | =head1 NAME |
33 | |
34 | DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server - Support for Microsoft |
35 | SQL Server via DBD::ADO |
36 | |
37 | =head1 SYNOPSIS |
38 | |
39 | This subclass supports MSSQL server connections via L<DBD::ADO>. |
40 | |
41 | =head1 DESCRIPTION |
42 | |
43 | The MSSQL specific functionality is provided by |
44 | L<DBIx::Class::Storage::DBI::MSSQL>. |
45 | |
46 | =head1 EXAMPLE DSN |
47 | |
48 | dbi:ADO:provider=sqlncli10;server=EEEBOX\SQLEXPRESS |
49 | |
50 | =head1 CAVEATS |
51 | |
52 | =head2 identities |
53 | |
54 | C<_identity_method> is set to C<@@identity>, as C<SCOPE_IDENTITY()> doesn't work |
55 | with L<DBD::ADO>. See L<DBIx::Class::Storage::DBI::MSSQL/IMPLEMENTATION NOTES> |
56 | for caveats regarding this. |
57 | |
58 | =head2 truncation bug |
59 | |
60 | There is a bug with MSSQL ADO providers where data gets truncated based on the |
61 | size of the bind sizes in the first prepare call: |
62 | |
63 | L<https://rt.cpan.org/Ticket/Display.html?id=52048> |
64 | |
5529838f |
65 | The C<ado_size> workaround is used (see L<DBD::ADO/ADO providers>) with the |
56dca25f |
66 | approximate maximum size of the data_type of the bound column, or 8000 (maximum |
67 | VARCHAR size) if the data_type is not available. |
68 | |
2edf3352 |
69 | Please report problems with this driver and send patches. |
70 | |
71 | =head2 LongReadLen |
72 | |
73 | C<LongReadLen> is set to C<LongReadLen * 2 + 1> on connection as it is necessary |
74 | for some LOB types. Be aware of this if you localize this value on the C<$dbh> |
75 | directly. |
76 | |
77 | =head2 binary data |
78 | |
79 | Due perhaps to the ado_size workaround we use, and/or other reasons, binary data |
80 | such as C<varbinary> column data comes back padded with trailing C<NULL> chars. |
81 | The Cursor class for this driver |
82 | (L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor>) removes them, |
83 | of course if your binary data is actually C<NULL> padded that may be an issue to |
84 | keep in mind when using this driver. |
85 | |
86 | =head2 uniqueidentifier columns |
87 | |
88 | uniqueidentifier columns come back from ADO wrapped in braces and must be |
89 | submitted to the MSSQL ADO driver wrapped in braces. We take care of this |
90 | transparently in this driver and the associated Cursor class |
91 | (L<DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor>) so that you |
92 | don't have to use braces in most cases (except in literal SQL, in those cases |
93 | you will have to add the braces yourself.) |
56dca25f |
94 | |
95 | =head2 fractional seconds |
96 | |
97 | Fractional seconds with L<DBIx::Class::InflateColumn::DateTime> are not |
98 | currently supported, datetimes are truncated at the second. |
99 | |
100 | =cut |
101 | |
2edf3352 |
102 | sub _init { |
4ffa5700 |
103 | my $self = shift; |
2edf3352 |
104 | |
105 | # SCOPE_IDENTITY() doesn't work |
4ffa5700 |
106 | $self->_identity_method('@@identity'); |
2edf3352 |
107 | $self->_no_scope_identity_query(1); |
108 | |
109 | return $self->next::method(@_); |
4ffa5700 |
110 | } |
111 | |
2edf3352 |
112 | sub _run_connection_actions { |
113 | my $self = shift; |
114 | |
115 | # make transactions work |
116 | require DBD::ADO::Const; |
117 | $self->_dbh->{ado_conn}{CursorLocation} = |
118 | DBD::ADO::Const->Enums->{CursorLocationEnum}{adUseClient}; |
119 | |
120 | # set LongReadLen = LongReadLen * 2 + 1 |
121 | # this may need to be in ADO.pm, being conservative for now... |
122 | my $long_read_len = $self->_dbh->{LongReadLen}; |
123 | |
124 | # This is the DBD::ADO default. |
125 | if ($long_read_len != 2147483647) { |
126 | $self->_dbh->{LongReadLen} = $long_read_len * 2 + 1; |
127 | } |
128 | |
129 | return $self->next::method(@_); |
130 | } |
131 | |
132 | |
133 | # Fix up binary data and GUIDs for ->find, for cursors see the cursor_class |
134 | # above. |
135 | sub select_single { |
136 | my $self = shift; |
137 | my ($ident, $select) = @_; |
138 | |
139 | my @row = $self->next::method(@_); |
140 | |
141 | return @row unless $self->cursor_class->isa( |
142 | 'DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::Cursor' |
143 | ); |
144 | |
616ca57f |
145 | my $col_infos = fromspec_columns_info($ident); |
2edf3352 |
146 | |
147 | _normalize_guids($select, $col_infos, \@row, $self); |
148 | |
5efba7fc |
149 | _strip_trailing_binary_nulls($select, $col_infos, \@row, $self); |
2edf3352 |
150 | |
151 | return @row; |
152 | } |
153 | |
154 | # We need to catch VARCHAR(max) before bind_attribute_by_data_type because it |
155 | # could be specified by size, also if bind_attribute_by_data_type fails we want |
156 | # to specify the default ado_size of 8000. |
157 | # Also make sure GUID binds have braces on them or else ADO throws an "Invalid |
158 | # character value for cast specification" |
159 | |
0e773352 |
160 | sub _dbi_attrs_for_bind { |
2edf3352 |
161 | my $self = shift; |
162 | my ($ident, $bind) = @_; |
163 | |
164 | my $lob_max = $self->_get_dbh->{LongReadLen} || 32768; |
165 | |
166 | foreach my $bind (@$bind) { |
167 | my $attrs = $bind->[0]; |
168 | my $data_type = $attrs->{sqlt_datatype}; |
169 | my $size = $attrs->{sqlt_size}; |
170 | |
171 | if ($size && lc($size) eq 'max') { |
172 | if ($data_type =~ /^(?:varchar|character varying|nvarchar|national char varying|national character varying|varbinary)\z/i) { |
173 | $attrs->{dbd_attrs} = { ado_size => $lob_max }; |
174 | } |
175 | else { |
176 | carp_unique "bizarre data_type '$data_type' with size => 'max'"; |
177 | } |
178 | } |
179 | |
180 | if ($self->_is_guid_type($data_type) && substr($bind->[1], 0, 1) ne '{') { |
181 | $bind->[1] = '{' . $bind->[1] . '}'; |
182 | } |
183 | } |
184 | |
185 | my $attrs = $self->next::method(@_); |
186 | |
e7b6c2a4 |
187 | # The next::method above caches the returned hashrefs in a _dbh related |
188 | # structure. It is safe for us to modify it in this manner, as the default |
189 | # does not really change (albeit the entire logic is insane and is pending |
190 | # a datatype-objects rewrite) |
191 | $_ and $_->{ado_size} ||= 8000 for @$attrs; |
2edf3352 |
192 | |
193 | return $attrs; |
194 | } |
8bcd9ece |
195 | |
2a6dda4b |
196 | # Can't edit all the binds in _dbi_attrs_for_bind for _insert_bulk, so we take |
2edf3352 |
197 | # care of those GUIDs here. |
2a6dda4b |
198 | sub _insert_bulk { |
2edf3352 |
199 | my $self = shift; |
200 | my ($source, $cols, $data) = @_; |
201 | |
202 | my $columns_info = $source->columns_info($cols); |
203 | |
204 | my $col_idx = 0; |
205 | foreach my $col (@$cols) { |
206 | if ($self->_is_guid_type($columns_info->{$col}{data_type})) { |
207 | foreach my $data_row (@$data) { |
208 | if (substr($data_row->[$col_idx], 0, 1) ne '{') { |
209 | $data_row->[$col_idx] = '{' . $data_row->[$col_idx] . '}'; |
210 | } |
211 | } |
212 | } |
213 | $col_idx++; |
b3857e35 |
214 | } |
215 | |
2edf3352 |
216 | return $self->next::method(@_); |
b3857e35 |
217 | } |
218 | |
219 | sub bind_attribute_by_data_type { |
220 | my ($self, $data_type) = @_; |
221 | |
2edf3352 |
222 | $data_type = lc $data_type; |
48012f35 |
223 | |
b3857e35 |
224 | my $max_size = |
225 | $self->_mssql_max_data_type_representation_size_in_bytes->{$data_type}; |
226 | |
227 | my $res = {}; |
2edf3352 |
228 | |
229 | if ($max_size) { |
230 | $res->{ado_size} = $max_size; |
231 | } |
232 | else { |
233 | carp_unique "could not map data_type '$data_type' to a max size for ado_size: defaulting to 8000"; |
234 | } |
b3857e35 |
235 | |
236 | return $res; |
237 | } |
238 | |
2edf3352 |
239 | # FIXME This list is an abomination. We need a way to do this outside |
4a0eed52 |
240 | # of the scope of DBIC, as it is right now nobody will ever think to |
2edf3352 |
241 | # even look here to diagnose some sort of misbehavior. |
b3857e35 |
242 | sub _mssql_max_data_type_representation_size_in_bytes { |
243 | my $self = shift; |
244 | |
2edf3352 |
245 | my $lob_max = $self->_get_dbh->{LongReadLen} || 32768; |
b3857e35 |
246 | |
247 | return +{ |
48012f35 |
248 | # MSSQL types |
b3857e35 |
249 | char => 8000, |
2edf3352 |
250 | character => 8000, |
b3857e35 |
251 | varchar => 8000, |
2edf3352 |
252 | 'varchar(max)' => $lob_max, |
253 | 'character varying' => 8000, |
b3857e35 |
254 | binary => 8000, |
255 | varbinary => 8000, |
2edf3352 |
256 | 'varbinary(max)' => $lob_max, |
257 | nchar => 16000, |
258 | 'national character' => 16000, |
259 | 'national char' => 16000, |
260 | nvarchar => 16000, |
261 | 'nvarchar(max)' => ($lob_max*2), |
262 | 'national character varying' => 16000, |
263 | 'national char varying' => 16000, |
b3857e35 |
264 | numeric => 100, |
265 | smallint => 100, |
266 | tinyint => 100, |
267 | smallmoney => 100, |
268 | bigint => 100, |
269 | bit => 100, |
270 | decimal => 100, |
2edf3352 |
271 | dec => 100, |
48012f35 |
272 | integer => 100, |
b3857e35 |
273 | int => 100, |
2edf3352 |
274 | 'int identity' => 100, |
275 | 'integer identity' => 100, |
b3857e35 |
276 | money => 100, |
277 | float => 100, |
2edf3352 |
278 | double => 100, |
279 | 'double precision' => 100, |
b3857e35 |
280 | real => 100, |
748eb620 |
281 | uniqueidentifier => 100, |
2edf3352 |
282 | ntext => $lob_max, |
283 | text => $lob_max, |
284 | image => $lob_max, |
b3857e35 |
285 | date => 100, |
286 | datetime => 100, |
287 | datetime2 => 100, |
288 | datetimeoffset => 100, |
289 | smalldatetime => 100, |
290 | time => 100, |
291 | timestamp => 100, |
48012f35 |
292 | cursor => 100, |
293 | hierarchyid => 100, |
2edf3352 |
294 | rowversion => 100, |
48012f35 |
295 | sql_variant => 100, |
2edf3352 |
296 | table => $lob_max, |
297 | xml => $lob_max, |
298 | |
299 | # mysql types |
300 | bool => 100, |
301 | boolean => 100, |
302 | 'tinyint unsigned' => 100, |
303 | 'smallint unsigned' => 100, |
304 | 'mediumint unsigned' => 100, |
305 | 'int unsigned' => 100, |
306 | 'integer unsigned' => 100, |
307 | 'bigint unsigned' => 100, |
308 | 'float unsigned' => 100, |
309 | 'double unsigned' => 100, |
310 | 'double precision unsigned' => 100, |
311 | 'decimal unsigned' => 100, |
312 | 'fixed' => 100, |
313 | 'year' => 100, |
314 | tinyblob => $lob_max, |
315 | tinytext => $lob_max, |
316 | blob => $lob_max, |
317 | text => $lob_max, |
318 | mediumblob => $lob_max, |
319 | mediumtext => $lob_max, |
320 | longblob => $lob_max, |
321 | longtext => $lob_max, |
322 | enum => 100, |
323 | set => 8000, |
324 | |
325 | # Pg types |
48012f35 |
326 | serial => 100, |
327 | bigserial => 100, |
2edf3352 |
328 | int8 => 100, |
329 | integer8 => 100, |
330 | serial8 => 100, |
331 | int4 => 100, |
332 | integer4 => 100, |
333 | serial4 => 100, |
334 | int2 => 100, |
335 | integer2 => 100, |
336 | float8 => 100, |
337 | float4 => 100, |
338 | 'bit varying' => 8000, |
339 | 'varbit' => 8000, |
340 | inet => 100, |
341 | cidr => 100, |
342 | macaddr => 100, |
343 | 'time without time zone' => 100, |
344 | 'time with time zone' => 100, |
345 | 'timestamp without time zone' => 100, |
346 | 'timestamp with time zone' => 100, |
347 | bytea => $lob_max, |
348 | |
349 | # DB2 types |
350 | graphic => 8000, |
351 | vargraphic => 8000, |
352 | 'long vargraphic' => $lob_max, |
353 | dbclob => $lob_max, |
354 | clob => $lob_max, |
355 | 'char for bit data' => 8000, |
356 | 'varchar for bit data' => 8000, |
357 | 'long varchar for bit data' => $lob_max, |
358 | |
359 | # oracle types |
48012f35 |
360 | varchar2 => 8000, |
2edf3352 |
361 | binary_float => 100, |
362 | binary_double => 100, |
363 | raw => 8000, |
364 | nclob => $lob_max, |
365 | long => $lob_max, |
366 | 'long raw' => $lob_max, |
367 | 'timestamp with local time zone' => 100, |
368 | |
369 | # Sybase ASE types |
370 | unitext => $lob_max, |
371 | unichar => 16000, |
372 | univarchar => 16000, |
373 | |
374 | # SQL Anywhere types |
375 | 'long varbit' => $lob_max, |
376 | 'long bit varying' => $lob_max, |
377 | uniqueidentifierstr => 100, |
378 | 'long binary' => $lob_max, |
379 | 'long varchar' => $lob_max, |
380 | 'long nvarchar' => $lob_max, |
381 | |
382 | # Firebird types |
383 | 'char(x) character set unicode_fss' => 16000, |
384 | 'varchar(x) character set unicode_fss' => 16000, |
385 | 'blob sub_type text' => $lob_max, |
386 | 'blob sub_type text character set unicode_fss' => $lob_max, |
387 | |
388 | # Informix types |
389 | smallfloat => 100, |
390 | byte => $lob_max, |
391 | lvarchar => 8000, |
392 | 'datetime year to fraction(5)' => 100, |
393 | # FIXME add other datetime types |
394 | |
395 | # MS Access types |
396 | autoincrement => 100, |
397 | long => 100, |
398 | integer4 => 100, |
399 | integer2 => 100, |
400 | integer1 => 100, |
401 | logical => 100, |
402 | logical1 => 100, |
403 | yesno => 100, |
404 | currency => 100, |
405 | single => 100, |
406 | ieeesingle => 100, |
407 | ieeedouble => 100, |
408 | number => 100, |
409 | string => 8000, |
410 | guid => 100, |
411 | longchar => $lob_max, |
412 | memo => $lob_max, |
413 | longbinary => $lob_max, |
b3857e35 |
414 | } |
8bcd9ece |
415 | } |
416 | |
56dca25f |
417 | package # hide from PAUSE |
418 | DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format; |
48012f35 |
419 | |
56dca25f |
420 | my $datetime_format = '%m/%d/%Y %I:%M:%S %p'; |
421 | my $datetime_parser; |
48012f35 |
422 | |
56dca25f |
423 | sub parse_datetime { |
424 | shift; |
425 | require DateTime::Format::Strptime; |
426 | $datetime_parser ||= DateTime::Format::Strptime->new( |
427 | pattern => $datetime_format, |
428 | on_error => 'croak', |
429 | ); |
430 | return $datetime_parser->parse_datetime(shift); |
431 | } |
48012f35 |
432 | |
56dca25f |
433 | sub format_datetime { |
434 | shift; |
435 | require DateTime::Format::Strptime; |
436 | $datetime_parser ||= DateTime::Format::Strptime->new( |
437 | pattern => $datetime_format, |
438 | on_error => 'croak', |
439 | ); |
440 | return $datetime_parser->format_datetime(shift); |
441 | } |
48012f35 |
442 | |
a2bd3796 |
443 | =head1 FURTHER QUESTIONS? |
4ffa5700 |
444 | |
a2bd3796 |
445 | Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>. |
4ffa5700 |
446 | |
a2bd3796 |
447 | =head1 COPYRIGHT AND LICENSE |
4ffa5700 |
448 | |
a2bd3796 |
449 | This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE> |
450 | by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can |
451 | redistribute it and/or modify it under the same terms as the |
452 | L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>. |
4ffa5700 |
453 | |
454 | =cut |
a2bd3796 |
455 | |
456 | 1; |
457 | |
56dca25f |
458 | # vim:sts=2 sw=2: |