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