lib/DBIx/Class/Storage/DBI/Sybase/ASE.pm

   1 package DBIx::Class::Storage::DBI::Sybase::ASE;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/
   7   DBIx::Class::Storage::DBI::Sybase
   8   DBIx::Class::Storage::DBI::AutoCast
   9   DBIx::Class::Storage::DBI::IdentityInsert
  10 /;
  11 use mro 'c3';
  12 use DBIx::Class::Carp;
  13 use Scalar::Util qw/blessed weaken/;
  14 use Sub::Name();
  15 use Try::Tiny;
  16 use Context::Preserve 'preserve_context';
  17 use DBIx::Class::_Util qw( sigwarn_silencer dbic_internal_try dump_value );
  18 use namespace::clean;
  19
  20 __PACKAGE__->sql_limit_dialect ('GenericSubQ');
  21 __PACKAGE__->sql_quote_char ([qw/[ ]/]);
  22 __PACKAGE__->datetime_parser_type(
  23   'DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format'
  24 );
  25
  26 __PACKAGE__->mk_group_accessors('simple' =>
  27     qw/_identity _identity_method _blob_log_on_update _parent_storage
  28        _writer_storage _is_writer_storage
  29        _bulk_storage _is_bulk_storage _began_bulk_work
  30     /
  31 );
  32
  33
  34 my @also_proxy_to_extra_storages = qw/
  35   connect_call_set_auto_cast auto_cast connect_call_blob_setup
  36   connect_call_datetime_setup
  37
  38   disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
  39   auto_savepoint unsafe cursor_class debug debugobj schema
  40 /;
  41
  42 =head1 NAME
  43
  44 DBIx::Class::Storage::DBI::Sybase::ASE - Sybase ASE SQL Server support for
  45 DBIx::Class
  46
  47 =head1 SYNOPSIS
  48
  49 This subclass supports L<DBD::Sybase> for real (non-Microsoft) Sybase databases.
  50
  51 =head1 DESCRIPTION
  52
  53 If your version of Sybase does not support placeholders, then your storage will
  54 be reblessed to L<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars>.
  55 You can also enable that driver explicitly, see the documentation for more
  56 details.
  57
  58 With this driver there is unfortunately no way to get the C<last_insert_id>
  59 without doing a C<SELECT MAX(col)>. This is done safely in a transaction
  60 (locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
  61
  62 A recommended L<connect_info|DBIx::Class::Storage::DBI/connect_info> setting:
  63
  64   on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
  65
  66 =head1 METHODS
  67
  68 =cut
  69
  70 sub _rebless {
  71   my $self = shift;
  72
  73   my $no_bind_vars = __PACKAGE__ . '::NoBindVars';
  74
  75   if ($self->_using_freetds) {
  76     carp_once <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
  77
  78 You are using FreeTDS with Sybase.
  79
  80 We will do our best to support this configuration, but please consider this
  81 support experimental.
  82
  83 TEXT/IMAGE columns will definitely not work.
  84
  85 You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
  86 instead.
  87
  88 See perldoc DBIx::Class::Storage::DBI::Sybase::ASE for more details.
  89
  90 To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
  91 variable.
  92 EOF
  93
  94     if (not $self->_use_typeless_placeholders) {
  95       if ($self->_use_placeholders) {
  96         $self->auto_cast(1);
  97       }
  98       else {
  99         $self->ensure_class_loaded($no_bind_vars);
 100         bless $self, $no_bind_vars;
 101         $self->_rebless;
 102       }
 103     }
 104   }
 105
 106   elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
 107     # not necessarily FreeTDS, but no placeholders nevertheless
 108     $self->ensure_class_loaded($no_bind_vars);
 109     bless $self, $no_bind_vars;
 110     $self->_rebless;
 111   }
 112   # this is highly unlikely, but we check just in case
 113   elsif (not $self->_use_typeless_placeholders) {
 114     $self->auto_cast(1);
 115   }
 116 }
 117
 118 sub _init {
 119   my $self = shift;
 120
 121   $self->next::method(@_);
 122
 123   if ($self->_using_freetds && (my $ver = $self->_using_freetds_version||999) > 0.82) {
 124     carp_once(
 125       "Buggy FreeTDS version $ver detected, statement caching will not work and "
 126     . 'will be disabled.'
 127     );
 128     $self->disable_sth_caching(1);
 129   }
 130
 131   $self->_set_max_connect(256);
 132
 133 # create storage for insert/(update blob) transactions,
 134 # unless this is that storage
 135   return if $self->_parent_storage;
 136
 137   my $writer_storage = (ref $self)->new;
 138
 139   $writer_storage->_is_writer_storage(1); # just info
 140   $writer_storage->connect_info($self->connect_info);
 141   $writer_storage->auto_cast($self->auto_cast);
 142
 143   weaken ($writer_storage->{_parent_storage} = $self);
 144   $self->_writer_storage($writer_storage);
 145
 146 # create a bulk storage unless connect_info is a coderef
 147   return if ref($self->_dbi_connect_info->[0]) eq 'CODE';
 148
 149   my $bulk_storage = (ref $self)->new;
 150
 151   $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics
 152   $bulk_storage->connect_info($self->connect_info);
 153
 154 # this is why
 155   $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1';
 156
 157   weaken ($bulk_storage->{_parent_storage} = $self);
 158   $self->_bulk_storage($bulk_storage);
 159 }
 160
 161 for my $method (@also_proxy_to_extra_storages) {
 162   no strict 'refs';
 163   no warnings 'redefine';
 164
 165   my $replaced = __PACKAGE__->can($method);
 166
 167   *{$method} = Sub::Name::subname $method => sub {
 168     my $self = shift;
 169     $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
 170     $self->_bulk_storage->$replaced(@_)   if $self->_bulk_storage;
 171     return $self->$replaced(@_);
 172   };
 173 }
 174
 175 sub disconnect {
 176   my $self = shift;
 177
 178 # Even though we call $sth->finish for uses off the bulk API, there's still an
 179 # "active statement" warning on disconnect, which we throw away here.
 180 # This is due to the bug described in _insert_bulk.
 181 # Currently a noop because 'prepare' is used instead of 'prepare_cached'.
 182   local $SIG{__WARN__} = sigwarn_silencer(qr/active statement/i)
 183     if $self->_is_bulk_storage;
 184
 185 # so that next transaction gets a dbh
 186   $self->_began_bulk_work(0) if $self->_is_bulk_storage;
 187
 188   $self->next::method;
 189 }
 190
 191 # This is only invoked for FreeTDS drivers by ::Storage::DBI::Sybase::FreeTDS
 192 sub _set_autocommit_stmt {
 193   my ($self, $on) = @_;
 194
 195   return 'SET CHAINED ' . ($on ? 'OFF' : 'ON');
 196 }
 197
 198 # Set up session settings for Sybase databases for the connection.
 199 #
 200 # Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
 201 # DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
 202 # we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
 203 # only want when AutoCommit is off.
 204 sub _run_connection_actions {
 205   my $self = shift;
 206
 207   if ($self->_is_bulk_storage) {
 208     # this should be cleared on every reconnect
 209     $self->_began_bulk_work(0);
 210     return;
 211   }
 212
 213   $self->_dbh->{syb_chained_txn} = 1
 214     unless $self->_using_freetds;
 215
 216   $self->next::method(@_);
 217 }
 218
 219 =head2 connect_call_blob_setup
 220
 221 Used as:
 222
 223   on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
 224
 225 Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
 226 instead of as a hex string.
 227
 228 Recommended.
 229
 230 Also sets the C<log_on_update> value for blob write operations. The default is
 231 C<1>, but C<0> is better if your database is configured for it.
 232
 233 See
 234 L<DBD::Sybase/Handling IMAGE/TEXT data with syb_ct_get_data()/syb_ct_send_data()>.
 235
 236 =cut
 237
 238 sub connect_call_blob_setup {
 239   my $self = shift;
 240   my %args = @_;
 241   my $dbh = $self->_dbh;
 242   $dbh->{syb_binary_images} = 1;
 243
 244   $self->_blob_log_on_update($args{log_on_update})
 245     if exists $args{log_on_update};
 246 }
 247
 248 sub _is_lob_column {
 249   my ($self, $source, $column) = @_;
 250
 251   return $self->_is_lob_type($source->column_info($column)->{data_type});
 252 }
 253
 254 sub _prep_for_execute {
 255   my ($self, $op, $ident, $args) = @_;
 256
 257   my $limit;  # extract and use shortcut on limit without offset
 258   if ($op eq 'select' and ! $args->[4] and $limit = $args->[3]) {
 259     $args = [ @$args ];
 260     $args->[3] = undef;
 261   }
 262
 263   my ($sql, $bind) = $self->next::method($op, $ident, $args);
 264
 265   # $limit is already sanitized by now
 266   $sql = join( "\n",
 267     "SET ROWCOUNT $limit",
 268     $sql,
 269     "SET ROWCOUNT 0",
 270   ) if $limit;
 271
 272   if (my $identity_col = $self->_perform_autoinc_retrieval) {
 273     $sql .= "\n" . $self->_fetch_identity_sql($ident, $identity_col)
 274   }
 275
 276   return ($sql, $bind);
 277 }
 278
 279 sub _fetch_identity_sql {
 280   my ($self, $source, $col) = @_;
 281
 282   return sprintf ("SELECT MAX(%s) FROM %s",
 283     map { $self->sql_maker->_quote ($_) } ($col, $source->from)
 284   );
 285 }
 286
 287 # Stolen from SQLT, with some modifications. This is a makeshift
 288 # solution before a sane type-mapping library is available, thus
 289 # the 'our' for easy overrides.
 290 our %TYPE_MAPPING  = (
 291     number    => 'numeric',
 292     money     => 'money',
 293     varchar   => 'varchar',
 294     varchar2  => 'varchar',
 295     timestamp => 'datetime',
 296     text      => 'varchar',
 297     real      => 'double precision',
 298     comment   => 'text',
 299     bit       => 'bit',
 300     tinyint   => 'smallint',
 301     float     => 'double precision',
 302     serial    => 'numeric',
 303     bigserial => 'numeric',
 304     boolean   => 'varchar',
 305     long      => 'varchar',
 306 );
 307
 308 sub _native_data_type {
 309   my ($self, $type) = @_;
 310
 311   $type = lc $type;
 312   $type =~ s/\s* identity//x;
 313
 314   return uc($TYPE_MAPPING{$type} || $type);
 315 }
 316
 317
 318 sub _execute {
 319   my $self = shift;
 320   my ($rv, $sth, @bind) = $self->next::method(@_);
 321
 322   $self->_identity( ($sth->fetchall_arrayref)->[0][0] )
 323     if $self->_perform_autoinc_retrieval;
 324
 325   return wantarray ? ($rv, $sth, @bind) : $rv;
 326 }
 327
 328 sub last_insert_id { shift->_identity }
 329
 330 # handles TEXT/IMAGE and transaction for last_insert_id
 331 sub insert {
 332   my $self = shift;
 333   my ($source, $to_insert) = @_;
 334
 335   my $columns_info = $source->columns_info;
 336
 337   my ($identity_col) = grep
 338     { $columns_info->{$_}{is_auto_increment} }
 339     keys %$columns_info
 340   ;
 341
 342   $identity_col = '' if ! defined $identity_col;
 343
 344   # FIXME - this is duplication from DBI.pm. When refactored towards
 345   # the LobWriter this can be folded back where it belongs.
 346   local $self->{_autoinc_supplied_for_op} = exists $to_insert->{$identity_col}
 347     ? 1
 348     : 0
 349   ;
 350
 351   local $self->{_perform_autoinc_retrieval} = $self->{_autoinc_supplied_for_op}
 352     ? undef
 353     : $identity_col
 354   ;
 355
 356   # check for empty insert
 357   # INSERT INTO foo DEFAULT VALUES -- does not work with Sybase
 358   # try to insert explicit 'DEFAULT's instead (except for identity, timestamp
 359   # and computed columns)
 360   if (not %$to_insert) {
 361     for my $col ($source->columns) {
 362       next if $col eq $identity_col;
 363
 364       my $info = $source->column_info($col);
 365
 366       next if ref $info->{default_value} eq 'SCALAR'
 367         || (exists $info->{data_type} && (not defined $info->{data_type}));
 368
 369       next if $info->{data_type} && $info->{data_type} =~ /^timestamp\z/i;
 370
 371       $to_insert->{$col} = \'DEFAULT';
 372     }
 373   }
 374
 375   my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
 376
 377   # if a new txn is needed - it must happen on the _writer/new connection (for now)
 378   my $guard;
 379   if (
 380     ! $self->transaction_depth
 381       and
 382     (
 383       $blob_cols
 384         or
 385       # do we need the horrific SELECT MAX(COL) hack?
 386       (
 387         $self->_perform_autoinc_retrieval
 388           and
 389         ( ($self->_identity_method||'') ne '@@IDENTITY' )
 390       )
 391     )
 392   ) {
 393     $self = $self->_writer_storage;
 394     $guard = $self->txn_scope_guard;
 395   }
 396
 397   my $updated_cols = $self->next::method ($source, $to_insert);
 398
 399   $self->_insert_blobs (
 400     $source,
 401     $blob_cols,
 402     {
 403       ( $identity_col
 404         ? ( $identity_col => $self->last_insert_id($source, $identity_col) )
 405         : ()
 406       ),
 407       %$to_insert,
 408       %$updated_cols,
 409     },
 410   ) if $blob_cols;
 411
 412   $guard->commit if $guard;
 413
 414   return $updated_cols;
 415 }
 416
 417 sub update {
 418   my $self = shift;
 419   my ($source, $fields, $where, @rest) = @_;
 420
 421   #
 422   # When *updating* identities, ASE requires SET IDENTITY_UPDATE called
 423   #
 424   if (my $blob_cols = $self->_remove_blob_cols($source, $fields)) {
 425
 426     # If there are any blobs in $where, Sybase will return a descriptive error
 427     # message.
 428     # XXX blobs can still be used with a LIKE query, and this should be handled.
 429
 430     # update+blob update(s) done atomically on separate connection
 431     $self = $self->_writer_storage;
 432
 433     my $guard = $self->txn_scope_guard;
 434
 435     # First update the blob columns to be updated to '' (taken from $fields, where
 436     # it is originally put by _remove_blob_cols .)
 437     my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols;
 438
 439     # We can't only update NULL blobs, because blobs cannot be in the WHERE clause.
 440     $self->next::method($source, \%blobs_to_empty, $where, @rest);
 441
 442     # Now update the blobs before the other columns in case the update of other
 443     # columns makes the search condition invalid.
 444     my $rv = $self->_update_blobs($source, $blob_cols, $where);
 445
 446     if (keys %$fields) {
 447
 448       # Now set the identity update flags for the actual update
 449       local $self->{_autoinc_supplied_for_op} = grep
 450         { $_->{is_auto_increment} }
 451         values %{ $source->columns_info([ keys %$fields ]) }
 452       ;
 453
 454       my $next = $self->next::can;
 455       my $args = \@_;
 456       return preserve_context {
 457         $self->$next(@$args);
 458       } after => sub { $guard->commit };
 459     }
 460     else {
 461       $guard->commit;
 462       return $rv;
 463     }
 464   }
 465   else {
 466     # Set the identity update flags for the actual update
 467     local $self->{_autoinc_supplied_for_op} = grep
 468       { $_->{is_auto_increment} }
 469       values %{ $source->columns_info([ keys %$fields ]) }
 470     ;
 471
 472     return $self->next::method(@_);
 473   }
 474 }
 475
 476 sub _insert_bulk {
 477   my $self = shift;
 478   my ($source, $cols, $data) = @_;
 479
 480   my $columns_info = $source->columns_info;
 481
 482   my ($identity_col) =
 483     grep { $columns_info->{$_}{is_auto_increment} }
 484       keys %$columns_info;
 485
 486   # FIXME - this is duplication from DBI.pm. When refactored towards
 487   # the LobWriter this can be folded back where it belongs.
 488   local $self->{_autoinc_supplied_for_op}
 489     = grep { $_ eq $identity_col } @$cols;
 490
 491   my $use_bulk_api =
 492     $self->_bulk_storage &&
 493     $self->_get_dbh->{syb_has_blk};
 494
 495   if (! $use_bulk_api and ref($self->_dbi_connect_info->[0]) eq 'CODE') {
 496     carp_unique( join ' ',
 497       'Bulk API support disabled due to use of a CODEREF connect_info.',
 498       'Reverting to regular array inserts.',
 499     );
 500   }
 501
 502   if (not $use_bulk_api) {
 503     my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data);
 504
 505 # next::method uses a txn anyway, but it ends too early in case we need to
 506 # select max(col) to get the identity for inserting blobs.
 507     ($self, my $guard) = $self->transaction_depth
 508       ? ($self, undef)
 509       : ($self->_writer_storage, $self->_writer_storage->txn_scope_guard)
 510     ;
 511
 512     $self->next::method(@_);
 513
 514     if ($blob_cols) {
 515       if ($self->_autoinc_supplied_for_op) {
 516         $self->_insert_blobs_array ($source, $blob_cols, $cols, $data);
 517       }
 518       else {
 519         my @cols_with_identities = (@$cols, $identity_col);
 520
 521         ## calculate identities
 522         # XXX This assumes identities always increase by 1, which may or may not
 523         # be true.
 524         my ($last_identity) =
 525           $self->_dbh->selectrow_array (
 526             $self->_fetch_identity_sql($source, $identity_col)
 527           );
 528         my @identities = (($last_identity - @$data + 1) .. $last_identity);
 529
 530         my @data_with_identities = map [@$_, shift @identities], @$data;
 531
 532         $self->_insert_blobs_array (
 533           $source, $blob_cols, \@cols_with_identities, \@data_with_identities
 534         );
 535       }
 536     }
 537
 538     $guard->commit if $guard;
 539
 540     return;
 541   }
 542
 543 # otherwise, use the bulk API
 544
 545 # rearrange @$data so that columns are in database order
 546 # and so we submit a full column list
 547   my %orig_order = map { $cols->[$_] => $_ } 0..$#$cols;
 548
 549   my @source_columns = $source->columns;
 550
 551   # bcp identity index is 1-based
 552   my ($identity_idx) = grep { $source_columns[$_] eq $identity_col } (0..$#source_columns);
 553   $identity_idx = defined $identity_idx ? $identity_idx + 1 : 0;
 554
 555   my @new_data;
 556   for my $slice_idx (0..$#$data) {
 557     push @new_data, [map {
 558       # identity data will be 'undef' if not _autoinc_supplied_for_op()
 559       # columns with defaults will also be 'undef'
 560       exists $orig_order{$_}
 561         ? $data->[$slice_idx][$orig_order{$_}]
 562         : undef
 563     } @source_columns];
 564   }
 565
 566   my $proto_bind = $self->_resolve_bindattrs(
 567     $source,
 568     [map {
 569       [ { dbic_colname => $source_columns[$_], _bind_data_slice_idx => $_ }
 570         => $new_data[0][$_] ]
 571     } (0 ..$#source_columns) ],
 572     $columns_info
 573   );
 574
 575 ## Set a client-side conversion error handler, straight from DBD::Sybase docs.
 576 # This ignores any data conversion errors detected by the client side libs, as
 577 # they are usually harmless.
 578   my $orig_cslib_cb = DBD::Sybase::set_cslib_cb(
 579     Sub::Name::subname _insert_bulk_cslib_errhandler => sub {
 580       my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_;
 581
 582       return 1 if $errno == 36;
 583
 584       carp
 585         "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" .
 586         ($errmsg ? "\n$errmsg" : '') .
 587         ($osmsg  ? "\n$osmsg"  : '')  .
 588         ($blkmsg ? "\n$blkmsg" : '');
 589
 590       return 0;
 591   });
 592
 593   my $exception = '';
 594   dbic_internal_try {
 595     my $bulk = $self->_bulk_storage;
 596
 597     my $guard = $bulk->txn_scope_guard;
 598
 599 ## FIXME - once this is done - address the FIXME on finish() below
 600 ## XXX get this to work instead of our own $sth
 601 ## will require SQLA or *Hacks changes for ordered columns
 602 #    $bulk->next::method($source, \@source_columns, \@new_data, {
 603 #      syb_bcp_attribs => {
 604 #        identity_flag   => $self->_autoinc_supplied_for_op ? 1 : 0,
 605 #        identity_column => $identity_idx,
 606 #      }
 607 #    });
 608     my $sql = 'INSERT INTO ' .
 609       $bulk->sql_maker->_quote($source->name) . ' (' .
 610 # colname list is ignored for BCP, but does no harm
 611       (join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '.
 612       ' VALUES ('.  (join ', ', ('?') x @source_columns) . ')';
 613
 614 ## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for
 615 ## a prepare_cached statement ineffective. Replace with ->sth when fixed, or
 616 ## better yet the version above. Should be fixed in DBD::Sybase .
 617     my $sth = $bulk->_get_dbh->prepare($sql,
 618 #      'insert', # op
 619       {
 620         syb_bcp_attribs => {
 621           identity_flag   => $self->_autoinc_supplied_for_op ? 1 : 0,
 622           identity_column => $identity_idx,
 623         }
 624       }
 625     );
 626
 627     {
 628       # FIXME the $sth->finish in _execute_array does a rollback for some
 629       # reason. Disable it temporarily until we fix the SQLMaker thing above
 630       no warnings 'redefine';
 631       no strict 'refs';
 632       local *{ref($sth).'::finish'} = sub {};
 633
 634       $self->_dbh_execute_for_fetch(
 635         $source, $sth, $proto_bind, \@source_columns, \@new_data
 636       );
 637     }
 638
 639     $guard->commit;
 640
 641     $bulk->_query_end($sql);
 642   } catch {
 643     $exception = shift;
 644   };
 645
 646   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 647
 648   if ($exception =~ /-Y option/) {
 649     my $w = 'Sybase bulk API operation failed due to character set incompatibility, '
 650           . 'reverting to regular array inserts. Try unsetting the LC_ALL environment variable'
 651     ;
 652     $w .= "\n$exception" if $self->debug;
 653     carp $w;
 654
 655     $self->_bulk_storage(undef);
 656     unshift @_, $self;
 657     goto \&_insert_bulk;
 658   }
 659   elsif ($exception) {
 660 # rollback makes the bulkLogin connection unusable
 661     $self->_bulk_storage->disconnect;
 662     $self->throw_exception($exception);
 663   }
 664 }
 665
 666 # Make sure blobs are not bound as placeholders, and return any non-empty ones
 667 # as a hash.
 668 sub _remove_blob_cols {
 669   my ($self, $source, $fields) = @_;
 670
 671   my %blob_cols;
 672
 673   for my $col (keys %$fields) {
 674     if ($self->_is_lob_column($source, $col)) {
 675       my $blob_val = delete $fields->{$col};
 676       if (not defined $blob_val) {
 677         $fields->{$col} = \'NULL';
 678       }
 679       else {
 680         $fields->{$col} = \"''";
 681         $blob_cols{$col} = $blob_val
 682           if length $blob_val;
 683       }
 684     }
 685   }
 686
 687   return %blob_cols ? \%blob_cols : undef;
 688 }
 689
 690 # same for _insert_bulk
 691 sub _remove_blob_cols_array {
 692   my ($self, $source, $cols, $data) = @_;
 693
 694   my @blob_cols;
 695
 696   for my $i (0..$#$cols) {
 697     my $col = $cols->[$i];
 698
 699     if ($self->_is_lob_column($source, $col)) {
 700       for my $j (0..$#$data) {
 701         my $blob_val = delete $data->[$j][$i];
 702         if (not defined $blob_val) {
 703           $data->[$j][$i] = \'NULL';
 704         }
 705         else {
 706           $data->[$j][$i] = \"''";
 707           $blob_cols[$j][$i] = $blob_val
 708             if length $blob_val;
 709         }
 710       }
 711     }
 712   }
 713
 714   return @blob_cols ? \@blob_cols : undef;
 715 }
 716
 717 sub _update_blobs {
 718   my ($self, $source, $blob_cols, $where) = @_;
 719
 720   my @primary_cols = dbic_internal_try
 721     { $source->_pri_cols_or_die }
 722     catch {
 723       $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
 724     };
 725
 726   my @pks_to_update;
 727   if (
 728     ref $where eq 'HASH'
 729       and
 730     ! grep { ! defined $where->{$_} } @primary_cols
 731   ) {
 732     my %row_to_update;
 733     @row_to_update{@primary_cols} = @{$where}{@primary_cols};
 734     @pks_to_update = \%row_to_update;
 735   }
 736   else {
 737     my $cursor = $self->select ($source, \@primary_cols, $where, {});
 738     @pks_to_update = map {
 739       my %row; @row{@primary_cols} = @$_; \%row
 740     } $cursor->all;
 741   }
 742
 743   for my $ident (@pks_to_update) {
 744     $self->_insert_blobs($source, $blob_cols, $ident);
 745   }
 746 }
 747
 748 sub _insert_blobs {
 749   my ($self, $source, $blob_cols, $row_data) = @_;
 750
 751   my $table = $source->name;
 752
 753   my @primary_cols = dbic_internal_try
 754     { $source->_pri_cols_or_die }
 755     catch {
 756       $self->throw_exception("Cannot update TEXT/IMAGE column(s): $_")
 757     };
 758
 759   $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
 760     if grep { ! defined $row_data->{$_} } @primary_cols;
 761
 762   # if we are 2-phase inserting a blob - there is nothing to retrieve anymore,
 763   # regardless of the previous state of the flag
 764   local $self->{_perform_autoinc_retrieval}
 765     if $self->_perform_autoinc_retrieval;
 766
 767   my %where = map {( $_ => $row_data->{$_} )} @primary_cols;
 768
 769   for my $col (keys %$blob_cols) {
 770     my $blob = $blob_cols->{$col};
 771
 772     my $cursor = $self->select ($source, [$col], \%where, {});
 773     $cursor->next;
 774     my $sth = $cursor->sth;
 775
 776     if (not $sth) {
 777       $self->throw_exception(
 778           "Could not find row in table '$table' for blob update:\n"
 779         . dump_value \%where
 780       );
 781     }
 782
 783     dbic_internal_try {
 784       do {
 785         $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
 786       } while $sth->fetch;
 787
 788       $sth->func('ct_prepare_send') or die $sth->errstr;
 789
 790       my $log_on_update = $self->_blob_log_on_update;
 791       $log_on_update    = 1 if not defined $log_on_update;
 792
 793       $sth->func('CS_SET', 1, {
 794         total_txtlen => length($blob),
 795         log_on_update => $log_on_update
 796       }, 'ct_data_info') or die $sth->errstr;
 797
 798       $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
 799
 800       $sth->func('ct_finish_send') or die $sth->errstr;
 801     }
 802     catch {
 803       if ($self->_using_freetds) {
 804         $self->throw_exception (
 805           "TEXT/IMAGE operation failed, probably because you are using FreeTDS: $_"
 806         );
 807       }
 808       else {
 809         $self->throw_exception($_);
 810       }
 811     }
 812     finally {
 813       $sth->finish if $sth;
 814     };
 815   }
 816 }
 817
 818 sub _insert_blobs_array {
 819   my ($self, $source, $blob_cols, $cols, $data) = @_;
 820
 821   for my $i (0..$#$data) {
 822     my $datum = $data->[$i];
 823
 824     my %row;
 825     @row{ @$cols } = @$datum;
 826
 827     my %blob_vals;
 828     for my $j (0..$#$cols) {
 829       if (exists $blob_cols->[$i][$j]) {
 830         $blob_vals{ $cols->[$j] } = $blob_cols->[$i][$j];
 831       }
 832     }
 833
 834     $self->_insert_blobs ($source, \%blob_vals, \%row);
 835   }
 836 }
 837
 838 =head2 connect_call_datetime_setup
 839
 840 Used as:
 841
 842   on_connect_call => 'datetime_setup'
 843
 844 In L<connect_info|DBIx::Class::Storage::DBI/connect_info> to set:
 845
 846   $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
 847   $dbh->do('set dateformat mdy');   # input fmt:  08/13/1979 18:08:55.080
 848
 849 This works for both C<DATETIME> and C<SMALLDATETIME> columns, note that
 850 C<SMALLDATETIME> columns only have minute precision.
 851
 852 =cut
 853
 854 sub connect_call_datetime_setup {
 855   my $self = shift;
 856   my $dbh = $self->_get_dbh;
 857
 858   if ($dbh->can('syb_date_fmt')) {
 859     # amazingly, this works with FreeTDS
 860     $dbh->syb_date_fmt('ISO_strict');
 861   }
 862   else {
 863     carp_once
 864       'Your DBD::Sybase is too old to support '
 865      .'DBIx::Class::InflateColumn::DateTime, please upgrade!';
 866
 867     # FIXME - in retrospect this is a rather bad US-centric choice
 868     # of format. Not changing as a bugwards compat, though in reality
 869     # the only piece that sees the results of $dt object formatting
 870     # (as opposed to parsing) is the database itself, so theoretically
 871     # changing both this SET command and the formatter definition of
 872     # ::S::D::Sybase::ASE::DateTime::Format below should be safe and
 873     # transparent
 874
 875     $dbh->do('SET DATEFORMAT mdy');
 876   }
 877 }
 878
 879
 880 sub _exec_txn_begin {
 881   my $self = shift;
 882
 883 # bulkLogin=1 connections are always in a transaction, and can only call BEGIN
 884 # TRAN once. However, we need to make sure there's a $dbh.
 885   return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work;
 886
 887   $self->next::method(@_);
 888
 889   $self->_began_bulk_work(1) if $self->_is_bulk_storage;
 890 }
 891
 892 # savepoint support using ASE syntax
 893
 894 sub _exec_svp_begin {
 895   my ($self, $name) = @_;
 896
 897   $self->_dbh->do("SAVE TRANSACTION $name");
 898 }
 899
 900 # A new SAVE TRANSACTION with the same name releases the previous one.
 901 sub _exec_svp_release { 1 }
 902
 903 sub _exec_svp_rollback {
 904   my ($self, $name) = @_;
 905
 906   $self->_dbh->do("ROLLBACK TRANSACTION $name");
 907 }
 908
 909 package # hide from PAUSE
 910   DBIx::Class::Storage::DBI::Sybase::ASE::DateTime::Format;
 911
 912 my $datetime_parse_format  = '%Y-%m-%dT%H:%M:%S.%3NZ';
 913 my $datetime_format_format = '%m/%d/%Y %H:%M:%S.%3N';
 914
 915 my ($datetime_parser, $datetime_formatter);
 916
 917 sub parse_datetime {
 918   shift;
 919   require DateTime::Format::Strptime;
 920   $datetime_parser ||= DateTime::Format::Strptime->new(
 921     pattern  => $datetime_parse_format,
 922     on_error => 'croak',
 923   );
 924   return $datetime_parser->parse_datetime(shift);
 925 }
 926
 927 sub format_datetime {
 928   shift;
 929   require DateTime::Format::Strptime;
 930   $datetime_formatter ||= DateTime::Format::Strptime->new(
 931     pattern  => $datetime_format_format,
 932     on_error => 'croak',
 933   );
 934   return $datetime_formatter->format_datetime(shift);
 935 }
 936
 937 1;
 938
 939 =head1 Schema::Loader Support
 940
 941 As of version C<0.05000>, L<DBIx::Class::Schema::Loader> should work well with
 942 most versions of Sybase ASE.
 943
 944 =head1 FreeTDS
 945
 946 This driver supports L<DBD::Sybase> compiled against FreeTDS
 947 (L<http://www.freetds.org/>) to the best of our ability, however it is
 948 recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
 949 libraries. They are a part of the Sybase ASE distribution:
 950
 951 The Open Client FAQ is here:
 952 L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
 953
 954 Sybase ASE for Linux (which comes with the Open Client libraries) may be
 955 downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
 956
 957 To see if you're using FreeTDS run:
 958
 959   perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
 960
 961 It is recommended to set C<tds version> for your ASE server to C<5.0> in
 962 C</etc/freetds/freetds.conf>.
 963
 964 Some versions or configurations of the libraries involved will not support
 965 placeholders, in which case the storage will be reblessed to
 966 L<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars>.
 967
 968 In some configurations, placeholders will work but will throw implicit type
 969 conversion errors for anything that's not expecting a string. In such a case,
 970 the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
 971 automatically set, which you may enable on connection with
 972 L<connect_call_set_auto_cast|DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>.
 973 The type info for the C<CAST>s is taken from the
 974 L<DBIx::Class::ResultSource/data_type> definitions in your Result classes, and
 975 are mapped to a Sybase type (if it isn't already) using a mapping based on
 976 L<SQL::Translator>.
 977
 978 In other configurations, placeholders will work just as they do with the Sybase
 979 Open Client libraries.
 980
 981 Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
 982
 983 =head1 INSERTS WITH PLACEHOLDERS
 984
 985 With placeholders enabled, inserts are done in a transaction so that there are
 986 no concurrency issues with getting the inserted identity value using
 987 C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
 988 mode.
 989
 990 In addition, they are done on a separate connection so that it's possible to
 991 have active cursors when doing an insert.
 992
 993 When using C<DBIx::Class::Storage::DBI::Sybase::ASE::NoBindVars> transactions
 994 are unnecessary and not used, as there are no concurrency issues with C<SELECT
 995 @@IDENTITY> which is a session variable.
 996
 997 =head1 TRANSACTIONS
 998
 999 Due to limitations of the TDS protocol and L<DBD::Sybase>, you cannot begin a
1000 transaction while there are active cursors, nor can you use multiple active
1001 cursors within a transaction. An active cursor is, for example, a
1002 L<ResultSet|DBIx::Class::ResultSet> that has been executed using C<next> or
1003 C<first> but has not been exhausted or L<reset|DBIx::Class::ResultSet/reset>.
1004
1005 For example, this will not work:
1006
1007   $schema->txn_do(sub {
1008     my $rs = $schema->resultset('Book');
1009     while (my $result = $rs->next) {
1010       $schema->resultset('MetaData')->create({
1011         book_id => $result->id,
1012         ...
1013       });
1014     }
1015   });
1016
1017 This won't either:
1018
1019   my $first_row = $large_rs->first;
1020   $schema->txn_do(sub { ... });
1021
1022 Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
1023 are not affected, as they are done on an extra database handle.
1024
1025 Some workarounds:
1026
1027 =over 4
1028
1029 =item * use L<DBIx::Class::Storage::DBI::Replicated>
1030
1031 =item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
1032
1033 =item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
1034
1035 =back
1036
1037 =head1 MAXIMUM CONNECTIONS
1038
1039 The TDS protocol makes separate connections to the server for active statements
1040 in the background. By default the number of such connections is limited to 25,
1041 on both the client side and the server side.
1042
1043 This is a bit too low for a complex L<DBIx::Class> application, so on connection
1044 the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
1045 can override it to whatever setting you like in the DSN.
1046
1047 See
1048 L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
1049 for information on changing the setting on the server side.
1050
1051 =head1 DATES
1052
1053 See L</connect_call_datetime_setup> to setup date formats
1054 for L<DBIx::Class::InflateColumn::DateTime>.
1055
1056 =head1 LIMITED QUERIES
1057
1058 Because ASE does not have a good way to limit results in SQL that works for
1059 all types of queries, the limit dialect is set to
1060 L<GenericSubQ|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ>.
1061
1062 Fortunately, ASE and L<DBD::Sybase> support cursors properly, so when
1063 L<GenericSubQ|DBIx::Class::SQLMaker::LimitDialects/GenericSubQ> is too slow
1064 you can use the L<software_limit|DBIx::Class::ResultSet/software_limit>
1065 L<DBIx::Class::ResultSet> attribute to simulate limited queries by skipping
1066 over records.
1067
1068 =head1 TEXT/IMAGE COLUMNS
1069
1070 L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
1071 C<TEXT/IMAGE> columns.
1072
1073 Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
1074
1075   $schema->storage->dbh->do("SET TEXTSIZE $bytes");
1076
1077 or
1078
1079   $schema->storage->set_textsize($bytes);
1080
1081 instead.
1082
1083 However, the C<LongReadLen> you pass in
1084 L<connect_info|DBIx::Class::Storage::DBI/connect_info> is used to execute the
1085 equivalent C<SET TEXTSIZE> command on connection.
1086
1087 See L</connect_call_blob_setup> for a
1088 L<connect_info|DBIx::Class::Storage::DBI/connect_info> setting you need to work
1089 with C<IMAGE> columns.
1090
1091 =head1 BULK API
1092
1093 The experimental L<DBD::Sybase> Bulk API support is used for
1094 L<populate|DBIx::Class::ResultSet/populate> in B<void> context, in a transaction
1095 on a separate connection.
1096
1097 To use this feature effectively, use a large number of rows for each
1098 L<populate|DBIx::Class::ResultSet/populate> call, eg.:
1099
1100   while (my $rows = $data_source->get_100_rows()) {
1101     $rs->populate($rows);
1102   }
1103
1104 B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
1105 calls in your C<Result> classes B<must> list columns in database order for this
1106 to work. Also, you may have to unset the C<LC_ALL> environment variable before
1107 loading your app, as C<BCP -Y> is not yet supported in DBD::Sybase .
1108
1109 When inserting IMAGE columns using this method, you'll need to use
1110 L</connect_call_blob_setup> as well.
1111
1112 =head1 COMPUTED COLUMNS
1113
1114 If you have columns such as:
1115
1116   created_dtm AS getdate()
1117
1118 represent them in your Result classes as:
1119
1120   created_dtm => {
1121     data_type => undef,
1122     default_value => \'getdate()',
1123     is_nullable => 0,
1124     inflate_datetime => 1,
1125   }
1126
1127 The C<data_type> must exist and must be C<undef>. Then empty inserts will work
1128 on tables with such columns.
1129
1130 =head1 TIMESTAMP COLUMNS
1131
1132 C<timestamp> columns in Sybase ASE are not really timestamps, see:
1133 L<http://dba.fyicenter.com/Interview-Questions/SYBASE/The_timestamp_datatype_in_Sybase_.html>.
1134
1135 They should be defined in your Result classes as:
1136
1137   ts => {
1138     data_type => 'timestamp',
1139     is_nullable => 0,
1140     inflate_datetime => 0,
1141   }
1142
1143 The C<<inflate_datetime => 0>> is necessary if you use
1144 L<DBIx::Class::InflateColumn::DateTime>, and most people do, and still want to
1145 be able to read these values.
1146
1147 The values will come back as hexadecimal.
1148
1149 =head1 TODO
1150
1151 =over
1152
1153 =item *
1154
1155 Transitions to AutoCommit=0 (starting a transaction) mode by exhausting
1156 any active cursors, using eager cursors.
1157
1158 =item *
1159
1160 Real limits and limited counts using stored procedures deployed on startup.
1161
1162 =item *
1163
1164 Blob update with a LIKE query on a blob, without invalidating the WHERE condition.
1165
1166 =item *
1167
1168 bulk_insert using prepare_cached (see comments.)
1169
1170 =back
1171
1172 =head1 FURTHER QUESTIONS?
1173
1174 Check the list of L<additional DBIC resources|DBIx::Class/GETTING HELP/SUPPORT>.
1175
1176 =head1 COPYRIGHT AND LICENSE
1177
1178 This module is free software L<copyright|DBIx::Class/COPYRIGHT AND LICENSE>
1179 by the L<DBIx::Class (DBIC) authors|DBIx::Class/AUTHORS>. You can
1180 redistribute it and/or modify it under the same terms as the
1181 L<DBIx::Class library|DBIx::Class/COPYRIGHT AND LICENSE>.