lib/DBIx/Class/Storage/DBI/ADO/Microsoft_SQL_Server.pm

   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';
  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 });
  29
  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
  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.)
  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
 100 sub _init {
 101   my $self = shift;
 102
 103 # SCOPE_IDENTITY() doesn't work
 104   $self->_identity_method('@@identity');
 105   $self->_no_scope_identity_query(1);
 106
 107   return $self->next::method(@_);
 108 }
 109
 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
 147   _strip_trailing_binary_nulls($select, $col_infos, \@row, $self);
 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
 158 sub _dbi_attrs_for_bind {
 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   # The next::method above caches the returned hashrefs in a _dbh related
 186   # structure. It is safe for us to modify it in this manner, as the default
 187   # does not really change (albeit the entire logic is insane and is pending
 188   # a datatype-objects rewrite)
 189   $_ and $_->{ado_size} ||= 8000 for @$attrs;
 190
 191   return $attrs;
 192 }
 193
 194 # Can't edit all the binds in _dbi_attrs_for_bind for _insert_bulk, so we take
 195 # care of those GUIDs here.
 196 sub _insert_bulk {
 197   my $self = shift;
 198   my ($source, $cols, $data) = @_;
 199
 200   my $columns_info = $source->columns_info($cols);
 201
 202   my $col_idx = 0;
 203   foreach my $col (@$cols) {
 204     if ($self->_is_guid_type($columns_info->{$col}{data_type})) {
 205       foreach my $data_row (@$data) {
 206         if (substr($data_row->[$col_idx], 0, 1) ne '{') {
 207           $data_row->[$col_idx] = '{' . $data_row->[$col_idx] . '}';
 208         }
 209       }
 210     }
 211     $col_idx++;
 212   }
 213
 214   return $self->next::method(@_);
 215 }
 216
 217 sub bind_attribute_by_data_type {
 218   my ($self, $data_type) = @_;
 219
 220   $data_type = lc $data_type;
 221
 222   my $max_size =
 223     $self->_mssql_max_data_type_representation_size_in_bytes->{$data_type};
 224
 225   my $res = {};
 226
 227   if ($max_size) {
 228     $res->{ado_size} = $max_size;
 229   }
 230   else {
 231     carp_unique "could not map data_type '$data_type' to a max size for ado_size: defaulting to 8000";
 232   }
 233
 234   return $res;
 235 }
 236
 237 # FIXME This list is an abomination. We need a way to do this outside
 238 # of the scope of DBIC, as it is right now nobody will ever think to
 239 # even look here to diagnose some sort of misbehavior.
 240 sub _mssql_max_data_type_representation_size_in_bytes {
 241   my $self = shift;
 242
 243   my $lob_max = $self->_get_dbh->{LongReadLen} || 32768;
 244
 245   return +{
 246 # MSSQL types
 247     char => 8000,
 248     character => 8000,
 249     varchar => 8000,
 250     'varchar(max)' => $lob_max,
 251     'character varying' => 8000,
 252     binary => 8000,
 253     varbinary => 8000,
 254     'varbinary(max)' => $lob_max,
 255     nchar => 16000,
 256     'national character' => 16000,
 257     'national char' => 16000,
 258     nvarchar => 16000,
 259     'nvarchar(max)' => ($lob_max*2),
 260     'national character varying' => 16000,
 261     'national char varying' => 16000,
 262     numeric => 100,
 263     smallint => 100,
 264     tinyint => 100,
 265     smallmoney => 100,
 266     bigint => 100,
 267     bit => 100,
 268     decimal => 100,
 269     dec => 100,
 270     integer => 100,
 271     int => 100,
 272     'int identity' => 100,
 273     'integer identity' => 100,
 274     money => 100,
 275     float => 100,
 276     double => 100,
 277     'double precision' => 100,
 278     real => 100,
 279     uniqueidentifier => 100,
 280     ntext => $lob_max,
 281     text => $lob_max,
 282     image => $lob_max,
 283     date => 100,
 284     datetime => 100,
 285     datetime2 => 100,
 286     datetimeoffset => 100,
 287     smalldatetime => 100,
 288     time => 100,
 289     timestamp => 100,
 290     cursor => 100,
 291     hierarchyid => 100,
 292     rowversion => 100,
 293     sql_variant => 100,
 294     table => $lob_max,
 295     xml => $lob_max,
 296
 297 # mysql types
 298     bool => 100,
 299     boolean => 100,
 300     'tinyint unsigned' => 100,
 301     'smallint unsigned' => 100,
 302     'mediumint unsigned' => 100,
 303     'int unsigned' => 100,
 304     'integer unsigned' => 100,
 305     'bigint unsigned' => 100,
 306     'float unsigned' => 100,
 307     'double unsigned' => 100,
 308     'double precision unsigned' => 100,
 309     'decimal unsigned' => 100,
 310     'fixed' => 100,
 311     'year' => 100,
 312     tinyblob => $lob_max,
 313     tinytext => $lob_max,
 314     blob => $lob_max,
 315     text => $lob_max,
 316     mediumblob => $lob_max,
 317     mediumtext => $lob_max,
 318     longblob => $lob_max,
 319     longtext => $lob_max,
 320     enum => 100,
 321     set => 8000,
 322
 323 # Pg types
 324     serial => 100,
 325     bigserial => 100,
 326     int8 => 100,
 327     integer8 => 100,
 328     serial8 => 100,
 329     int4 => 100,
 330     integer4 => 100,
 331     serial4 => 100,
 332     int2 => 100,
 333     integer2 => 100,
 334     float8 => 100,
 335     float4 => 100,
 336     'bit varying' => 8000,
 337     'varbit' => 8000,
 338     inet => 100,
 339     cidr => 100,
 340     macaddr => 100,
 341     'time without time zone' => 100,
 342     'time with time zone' => 100,
 343     'timestamp without time zone' => 100,
 344     'timestamp with time zone' => 100,
 345     bytea => $lob_max,
 346
 347 # DB2 types
 348     graphic => 8000,
 349     vargraphic => 8000,
 350     'long vargraphic' => $lob_max,
 351     dbclob => $lob_max,
 352     clob => $lob_max,
 353     'char for bit data' => 8000,
 354     'varchar for bit data' => 8000,
 355     'long varchar for bit data' => $lob_max,
 356
 357 # oracle types
 358     varchar2 => 8000,
 359     binary_float => 100,
 360     binary_double => 100,
 361     raw => 8000,
 362     nclob => $lob_max,
 363     long => $lob_max,
 364     'long raw' => $lob_max,
 365     'timestamp with local time zone' => 100,
 366
 367 # Sybase ASE types
 368     unitext => $lob_max,
 369     unichar => 16000,
 370     univarchar => 16000,
 371
 372 # SQL Anywhere types
 373     'long varbit' => $lob_max,
 374     'long bit varying' => $lob_max,
 375     uniqueidentifierstr => 100,
 376     'long binary' => $lob_max,
 377     'long varchar' => $lob_max,
 378     'long nvarchar' => $lob_max,
 379
 380 # Firebird types
 381     'char(x) character set unicode_fss' => 16000,
 382     'varchar(x) character set unicode_fss' => 16000,
 383     'blob sub_type text' => $lob_max,
 384     'blob sub_type text character set unicode_fss' => $lob_max,
 385
 386 # Informix types
 387     smallfloat => 100,
 388     byte => $lob_max,
 389     lvarchar => 8000,
 390     'datetime year to fraction(5)' => 100,
 391     # FIXME add other datetime types
 392
 393 # MS Access types
 394     autoincrement => 100,
 395     long => 100,
 396     integer4 => 100,
 397     integer2 => 100,
 398     integer1 => 100,
 399     logical => 100,
 400     logical1 => 100,
 401     yesno => 100,
 402     currency => 100,
 403     single => 100,
 404     ieeesingle => 100,
 405     ieeedouble => 100,
 406     number => 100,
 407     string => 8000,
 408     guid => 100,
 409     longchar => $lob_max,
 410     memo => $lob_max,
 411     longbinary => $lob_max,
 412   }
 413 }
 414
 415 package # hide from PAUSE
 416   DBIx::Class::Storage::DBI::ADO::Microsoft_SQL_Server::DateTime::Format;
 417
 418 my $datetime_format = '%m/%d/%Y %I:%M:%S %p';
 419 my $datetime_parser;
 420
 421 sub parse_datetime {
 422   shift;
 423   require DateTime::Format::Strptime;
 424   $datetime_parser ||= DateTime::Format::Strptime->new(
 425     pattern  => $datetime_format,
 426     on_error => 'croak',
 427   );
 428   return $datetime_parser->parse_datetime(shift);
 429 }
 430
 431 sub format_datetime {
 432   shift;
 433   require DateTime::Format::Strptime;
 434   $datetime_parser ||= DateTime::Format::Strptime->new(
 435     pattern  => $datetime_format,
 436     on_error => 'croak',
 437   );
 438   return $datetime_parser->format_datetime(shift);
 439 }
 440
 441 =head1 FURTHER QUESTIONS?
 442
 443 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
 444
 445 =head1 COPYRIGHT AND LICENSE
 446
 447 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
 448 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
 449 redistribute it and/or modify it under the same terms as the
 450 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.
 451
 452 =cut
 453
 454 1;
 455
 456 # vim:sts=2 sw=2: