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

   1 package DBIx::Class::Storage::DBI::Sybase;
   2
   3 use strict;
   4 use warnings;
   5
   6 use base qw/
   7     DBIx::Class::Storage::DBI::Sybase::Common
   8     DBIx::Class::Storage::DBI::AutoCast
   9 /;
  10 use mro 'c3';
  11 use Carp::Clan qw/^DBIx::Class/;
  12 use List::Util ();
  13 use Sub::Name ();
  14
  15 __PACKAGE__->mk_group_accessors('simple' =>
  16     qw/_identity _blob_log_on_update _writer_storage _is_extra_storage
  17        _bulk_storage _is_bulk_storage _began_bulk_work
  18        _bulk_disabled_due_to_coderef_connect_info_warned
  19        _identity_method/
  20 );
  21
  22 my @also_proxy_to_extra_storages = qw/
  23   disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
  24   auto_savepoint unsafe cursor_class debug debugobj schema
  25 /;
  26
  27 =head1 NAME
  28
  29 DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class
  30
  31 =head1 SYNOPSIS
  32
  33 This subclass supports L<DBD::Sybase> for real Sybase databases.  If you are
  34 using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
  35 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
  36
  37 =head1 DESCRIPTION
  38
  39 If your version of Sybase does not support placeholders, then your storage
  40 will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
  41 also enable that driver explicitly, see the documentation for more details.
  42
  43 With this driver there is unfortunately no way to get the C<last_insert_id>
  44 without doing a C<SELECT MAX(col)>. This is done safely in a transaction
  45 (locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
  46
  47 A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
  48
  49   on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
  50
  51 =head1 METHODS
  52
  53 =cut
  54
  55 sub _rebless {
  56   my $self = shift;
  57
  58   if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
  59     my $dbtype = eval {
  60       @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
  61     } || '';
  62
  63     my $exception = $@;
  64     $dbtype =~ s/\W/_/gi;
  65     my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
  66
  67     if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
  68       bless $self, $subclass;
  69       $self->_rebless;
  70     } else { # real Sybase
  71       my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
  72
  73       if ($self->using_freetds) {
  74         carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
  75
  76 You are using FreeTDS with Sybase.
  77
  78 We will do our best to support this configuration, but please consider this
  79 support experimental.
  80
  81 TEXT/IMAGE columns will definitely not work.
  82
  83 You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
  84 instead.
  85
  86 See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
  87
  88 To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
  89 variable.
  90 EOF
  91         if (not $self->_typeless_placeholders_supported) {
  92           if ($self->_placeholders_supported) {
  93             $self->auto_cast(1);
  94           } else {
  95             $self->ensure_class_loaded($no_bind_vars);
  96             bless $self, $no_bind_vars;
  97             $self->_rebless;
  98           }
  99         }
 100       }
 101       elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
 102         # not necessarily FreeTDS, but no placeholders nevertheless
 103         $self->ensure_class_loaded($no_bind_vars);
 104         bless $self, $no_bind_vars;
 105         $self->_rebless;
 106       } elsif (not $self->_typeless_placeholders_supported) {
 107         # this is highly unlikely, but we check just in case
 108         $self->auto_cast(1);
 109       }
 110     }
 111   }
 112 }
 113
 114 sub _init {
 115   my $self = shift;
 116   $self->_set_max_connect(256);
 117
 118   # based on LongReadLen in connect_info
 119   $self->set_textsize if $self->using_freetds;
 120
 121 # create storage for insert/(update blob) transactions,
 122 # unless this is that storage
 123   return if $self->_is_extra_storage;
 124
 125   my $writer_storage = (ref $self)->new;
 126
 127   $writer_storage->_is_extra_storage(1);
 128   $writer_storage->connect_info($self->connect_info);
 129
 130   $self->_writer_storage($writer_storage);
 131
 132 # create a bulk storage unless connect_info is a coderef
 133   return
 134     if (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE';
 135
 136   my $bulk_storage = (ref $self)->new;
 137
 138   $bulk_storage->_is_extra_storage(1);
 139   $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics
 140   $bulk_storage->connect_info($self->connect_info);
 141
 142 # this is why
 143   $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1';
 144
 145   $self->_bulk_storage($bulk_storage);
 146 }
 147
 148 for my $method (@also_proxy_to_extra_storages) {
 149   no strict 'refs';
 150   no warnings 'redefine';
 151
 152   my $replaced = __PACKAGE__->can($method);
 153
 154   *{$method} = Sub::Name::subname $method => sub {
 155     my $self = shift;
 156     $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
 157     $self->_bulk_storage->$replaced(@_)   if $self->_bulk_storage;
 158     return $self->$replaced(@_);
 159   };
 160 }
 161
 162 sub disconnect {
 163   my $self = shift;
 164
 165 # Even though we call $sth->finish for uses off the bulk API, there's still an
 166 # "active statement" warning on disconnect, which we throw away here.
 167 # This is due to the bug described in insert_bulk.
 168 # Currently a noop because 'prepare' is used instead of 'prepare_cached'.
 169   local $SIG{__WARN__} = sub {
 170     warn $_[0] unless $_[0] =~ /active statement/i;
 171   } if $self->_is_bulk_storage;
 172
 173 # so that next transaction gets a dbh
 174   $self->_began_bulk_work(0) if $self->_is_bulk_storage;
 175
 176   $self->next::method;
 177 }
 178
 179 # Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
 180 # DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
 181 # we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
 182 # only want when AutoCommit is off.
 183 sub _populate_dbh {
 184   my $self = shift;
 185
 186   $self->next::method(@_);
 187
 188   if ($self->_is_bulk_storage) {
 189 # this should be cleared on every reconnect
 190     $self->_began_bulk_work(0);
 191     return;
 192   }
 193
 194   if (not $self->using_freetds) {
 195     $self->_dbh->{syb_chained_txn} = 1;
 196   } else {
 197     if ($self->_dbh_autocommit) {
 198       $self->_dbh->do('SET CHAINED OFF');
 199     } else {
 200       $self->_dbh->do('SET CHAINED ON');
 201     }
 202   }
 203 }
 204
 205 =head2 connect_call_blob_setup
 206
 207 Used as:
 208
 209   on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
 210
 211 Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
 212 instead of as a hex string.
 213
 214 Recommended.
 215
 216 Also sets the C<log_on_update> value for blob write operations. The default is
 217 C<1>, but C<0> is better if your database is configured for it.
 218
 219 See
 220 L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
 221
 222 =cut
 223
 224 sub connect_call_blob_setup {
 225   my $self = shift;
 226   my %args = @_;
 227   my $dbh = $self->_dbh;
 228   $dbh->{syb_binary_images} = 1;
 229
 230   $self->_blob_log_on_update($args{log_on_update})
 231     if exists $args{log_on_update};
 232 }
 233
 234 sub _is_lob_type {
 235   my $self = shift;
 236   my $type = shift;
 237   $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
 238 }
 239
 240 sub _prep_for_execute {
 241   my $self = shift;
 242   my ($op, $extra_bind, $ident, $args) = @_;
 243
 244   my ($sql, $bind) = $self->next::method (@_);
 245
 246   if ($op eq 'insert') {
 247     my $table = $ident->from;
 248
 249     my $bind_info = $self->_resolve_column_info(
 250       $ident, [map $_->[0], @{$bind}]
 251     );
 252     my $identity_col = List::Util::first
 253       { $bind_info->{$_}{is_auto_increment} }
 254       (keys %$bind_info)
 255     ;
 256
 257     if ($identity_col) {
 258       $sql = join ("\n",
 259         "SET IDENTITY_INSERT $table ON",
 260         $sql,
 261         "SET IDENTITY_INSERT $table OFF",
 262       );
 263     }
 264     else {
 265       $identity_col = List::Util::first
 266         { $ident->column_info($_)->{is_auto_increment} }
 267         $ident->columns
 268       ;
 269     }
 270
 271     if ($identity_col) {
 272       $sql =
 273         "$sql\n" .
 274         $self->_fetch_identity_sql($ident, $identity_col);
 275     }
 276   }
 277
 278   return ($sql, $bind);
 279 }
 280
 281 # Stolen from SQLT, with some modifications. This is a makeshift
 282 # solution before a sane type-mapping library is available, thus
 283 # the 'our' for easy overrides.
 284 our %TYPE_MAPPING  = (
 285     number    => 'numeric',
 286     money     => 'money',
 287     varchar   => 'varchar',
 288     varchar2  => 'varchar',
 289     timestamp => 'datetime',
 290     text      => 'varchar',
 291     real      => 'double precision',
 292     comment   => 'text',
 293     bit       => 'bit',
 294     tinyint   => 'smallint',
 295     float     => 'double precision',
 296     serial    => 'numeric',
 297     bigserial => 'numeric',
 298     boolean   => 'varchar',
 299     long      => 'varchar',
 300 );
 301
 302 sub _native_data_type {
 303   my ($self, $type) = @_;
 304
 305   $type = lc $type;
 306   $type =~ s/\s* identity//x;
 307
 308   return uc($TYPE_MAPPING{$type} || $type);
 309 }
 310
 311 sub _fetch_identity_sql {
 312   my ($self, $source, $col) = @_;
 313
 314   return sprintf ("SELECT MAX(%s) FROM %s",
 315     map { $self->sql_maker->_quote ($_) } ($col, $source->from)
 316   );
 317 }
 318
 319 sub _execute {
 320   my $self = shift;
 321   my ($op) = @_;
 322
 323   my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
 324
 325   if ($op eq 'insert') {
 326     $self->_identity($sth->fetchrow_array);
 327     $sth->finish;
 328   }
 329
 330   return wantarray ? ($rv, $sth, @bind) : $rv;
 331 }
 332
 333 sub last_insert_id { shift->_identity }
 334
 335 # handles TEXT/IMAGE and transaction for last_insert_id
 336 sub insert {
 337   my $self = shift;
 338   my ($source, $to_insert) = @_;
 339
 340   my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
 341
 342   my $identity_col = List::Util::first
 343     { $source->column_info($_)->{is_auto_increment} }
 344     $source->columns;
 345
 346   # do we need the horrific SELECT MAX(COL) hack?
 347   my $dumb_last_insert_id =
 348        $identity_col
 349     && (not exists $to_insert->{$identity_col})
 350     && ($self->_identity_method||'') ne '@@IDENTITY';
 351
 352   my $next = $self->next::can;
 353
 354   # we are already in a transaction, or there are no blobs
 355   # and we don't need the PK - just (try to) do it
 356   if ($self->{transaction_depth}
 357         || (!$blob_cols && !$dumb_last_insert_id)
 358   ) {
 359     return $self->_insert (
 360       $next, $source, $to_insert, $blob_cols, $identity_col
 361     );
 362   }
 363
 364   # otherwise use the _writer_storage to do the insert+transaction on another
 365   # connection
 366   my $guard = $self->_writer_storage->txn_scope_guard;
 367
 368   my $updated_cols = $self->_writer_storage->_insert (
 369     $next, $source, $to_insert, $blob_cols, $identity_col
 370   );
 371
 372   $self->_identity($self->_writer_storage->_identity);
 373
 374   $guard->commit;
 375
 376   return $updated_cols;
 377 }
 378
 379 sub _insert {
 380   my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
 381
 382   my $updated_cols = $self->$next ($source, $to_insert);
 383
 384   my $final_row = {
 385     $identity_col => $self->last_insert_id($source, $identity_col),
 386     %$to_insert,
 387     %$updated_cols,
 388   };
 389
 390   $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
 391
 392   return $updated_cols;
 393 }
 394
 395 sub update {
 396   my $self = shift;
 397   my ($source, $fields, $where) = @_;
 398
 399   my $wantarray = wantarray;
 400   my $blob_cols = $self->_remove_blob_cols($source, $fields);
 401
 402   if (not $blob_cols) {
 403     return $self->next::method(@_);
 404   }
 405
 406 # update+blob update(s) done atomically on separate connection
 407   $self = $self->_writer_storage;
 408
 409   my $guard = $self->txn_scope_guard;
 410
 411   my @res;
 412   if ($wantarray) {
 413     @res    = $self->next::method(@_);
 414   }
 415   elsif (defined $wantarray) {
 416     $res[0] = $self->next::method(@_);
 417   }
 418   else {
 419     $self->next::method(@_);
 420   }
 421
 422   $self->_update_blobs($source, $blob_cols, $where);
 423
 424   $guard->commit;
 425
 426   return $wantarray ? @res : $res[0];
 427 }
 428
 429 ### the insert_bulk partially stolen from DBI/MSSQL.pm
 430
 431 sub _set_identity_insert {
 432   my ($self, $table) = @_;
 433
 434   my $sql = sprintf (
 435     'SET IDENTITY_INSERT %s ON',
 436     $self->sql_maker->_quote ($table),
 437   );
 438
 439   my $dbh = $self->_get_dbh;
 440   eval { $dbh->do ($sql) };
 441   if ($@) {
 442     $self->throw_exception (sprintf "Error executing '%s': %s",
 443       $sql,
 444       $dbh->errstr,
 445     );
 446   }
 447 }
 448
 449 sub _unset_identity_insert {
 450   my ($self, $table) = @_;
 451
 452   my $sql = sprintf (
 453     'SET IDENTITY_INSERT %s OFF',
 454     $self->sql_maker->_quote ($table),
 455   );
 456
 457   my $dbh = $self->_get_dbh;
 458   $dbh->do ($sql);
 459 }
 460
 461 ## XXX add blob support
 462 sub insert_bulk {
 463   my $self = shift;
 464   my ($source, $cols, $data) = @_;
 465
 466   my $is_identity_insert = (List::Util::first
 467     { $source->column_info ($_)->{is_auto_increment} } @{$cols}
 468   ) ? 1 : 0;
 469
 470   my @source_columns = $source->columns;
 471
 472   my $use_bulk_api =
 473     $self->_bulk_storage &&
 474     $self->_get_dbh->{syb_has_blk};
 475
 476   if ((not $use_bulk_api) &&
 477       (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE' &&
 478       (not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) {
 479     carp <<'EOF';
 480 Bulk API support disabled due to use of a CODEREF connect_info. Reverting to
 481 array inserts.
 482 EOF
 483     $self->_bulk_disabled_due_to_coderef_connect_info_warned(1);
 484   }
 485
 486   if (not $use_bulk_api) {
 487     if ($is_identity_insert) {
 488        $self->_set_identity_insert ($source->name);
 489     }
 490
 491     $self->next::method(@_);
 492
 493     if ($is_identity_insert) {
 494        $self->_unset_identity_insert ($source->name);
 495     }
 496
 497     return;
 498   }
 499
 500 # otherwise, use the bulk API
 501
 502 # rearrange @$data so that columns are in database order
 503   my %orig_idx;
 504   @orig_idx{@$cols} = 0..$#$cols;
 505
 506   my %new_idx;
 507   @new_idx{@source_columns} = 0..$#source_columns;
 508
 509   my @new_data;
 510   for my $datum (@$data) {
 511     my $new_datum = [];
 512     for my $col (@source_columns) {
 513 # identity data will be 'undef' if not $is_identity_insert
 514 # columns with defaults will also be 'undef'
 515       $new_datum->[ $new_idx{$col} ] =
 516         exists $orig_idx{$col} ? $datum->[ $orig_idx{$col} ] : undef;
 517     }
 518     push @new_data, $new_datum;
 519   }
 520
 521   my $identity_col = List::Util::first
 522     { $source->column_info($_)->{is_auto_increment} } @source_columns;
 523
 524 # bcp identity index is 1-based
 525   my $identity_idx = exists $new_idx{$identity_col} ?
 526     $new_idx{$identity_col} + 1 : 0;
 527
 528 ## Set a client-side conversion error handler, straight from DBD::Sybase docs.
 529 # This ignores any data conversion errors detected by the client side libs, as
 530 # they are usually harmless.
 531   my $orig_cslib_cb = DBD::Sybase::set_cslib_cb(
 532     Sub::Name::subname insert_bulk => sub {
 533       my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_;
 534
 535       return 1 if $errno == 36;
 536
 537       carp
 538         "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" .
 539         ($errmsg ? "\n$errmsg" : '') .
 540         ($osmsg  ? "\n$osmsg"  : '')  .
 541         ($blkmsg ? "\n$blkmsg" : '');
 542
 543       return 0;
 544   });
 545
 546   eval {
 547     my $bulk = $self->_bulk_storage;
 548
 549     my $guard = $bulk->txn_scope_guard;
 550
 551 ## XXX get this to work instead of our own $sth
 552 ## will require SQLA or *Hacks changes for ordered columns
 553 #    $bulk->next::method($source, \@source_columns, \@new_data, {
 554 #      syb_bcp_attribs => {
 555 #        identity_flag   => $is_identity_insert,
 556 #        identity_column => $identity_idx,
 557 #      }
 558 #    });
 559     my $sql = 'INSERT INTO ' .
 560       $bulk->sql_maker->_quote($source->name) . ' (' .
 561 # colname list is ignored for BCP, but does no harm
 562       (join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '.
 563       ' VALUES ('.  (join ', ', ('?') x @source_columns) . ')';
 564
 565 ## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for
 566 ## a prepare_cached statement ineffective. Replace with ->sth when fixed, or
 567 ## better yet the version above. Should be fixed in DBD::Sybase .
 568     my $sth = $bulk->_get_dbh->prepare($sql,
 569 #      'insert', # op
 570       {
 571         syb_bcp_attribs => {
 572           identity_flag   => $is_identity_insert,
 573           identity_column => $identity_idx,
 574         }
 575       }
 576     );
 577
 578     $bulk->_query_start($sql);
 579
 580     for my $datum (@new_data) {
 581       $sth->execute(@$datum);
 582       die $sth->errstr if $sth->errstr; # just in case
 583     }
 584
 585     $guard->commit;
 586     $sth->finish;
 587
 588     $bulk->_query_end($sql);
 589   };
 590   my $exception = $@;
 591   if ($exception =~ /-Y option/) {
 592     carp <<"EOF";
 593
 594 Sybase bulk API operation failed due to character set incompatibility, reverting
 595 to regular array inserts:
 596
 597 *** Try unsetting the LANG environment variable.
 598
 599 $@
 600 EOF
 601     $self->_bulk_storage(undef);
 602     DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 603     unshift @_, $self;
 604     goto \&insert_bulk;
 605   }
 606   elsif ($exception) {
 607     DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 608 # rollback makes the bulkLogin connection unusable
 609     $self->_bulk_storage->disconnect;
 610     $self->throw_exception($exception) if $exception;
 611   }
 612
 613   DBD::Sybase::set_cslib_cb($orig_cslib_cb);
 614 }
 615
 616 sub _remove_blob_cols {
 617   my ($self, $source, $fields) = @_;
 618
 619   my %blob_cols;
 620
 621   for my $col (keys %$fields) {
 622     if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
 623       $blob_cols{$col} = delete $fields->{$col};
 624       $fields->{$col} = \"''";
 625     }
 626   }
 627
 628   return keys %blob_cols ? \%blob_cols : undef;
 629 }
 630
 631 sub _update_blobs {
 632   my ($self, $source, $blob_cols, $where) = @_;
 633
 634   my (@primary_cols) = $source->primary_columns;
 635
 636   croak "Cannot update TEXT/IMAGE column(s) without a primary key"
 637     unless @primary_cols;
 638
 639 # check if we're updating a single row by PK
 640   my $pk_cols_in_where = 0;
 641   for my $col (@primary_cols) {
 642     $pk_cols_in_where++ if defined $where->{$col};
 643   }
 644   my @rows;
 645
 646   if ($pk_cols_in_where == @primary_cols) {
 647     my %row_to_update;
 648     @row_to_update{@primary_cols} = @{$where}{@primary_cols};
 649     @rows = \%row_to_update;
 650   } else {
 651     my $cursor = $self->select ($source, \@primary_cols, $where, {});
 652     @rows = map {
 653       my %row; @row{@primary_cols} = @$_; \%row
 654     } $cursor->all;
 655   }
 656
 657   for my $row (@rows) {
 658     $self->_insert_blobs($source, $blob_cols, $row);
 659   }
 660 }
 661
 662 sub _insert_blobs {
 663   my ($self, $source, $blob_cols, $row) = @_;
 664   my $dbh = $self->_get_dbh;
 665
 666   my $table = $source->from;
 667
 668   my %row = %$row;
 669   my (@primary_cols) = $source->primary_columns;
 670
 671   croak "Cannot update TEXT/IMAGE column(s) without a primary key"
 672     unless @primary_cols;
 673
 674   if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) {
 675     croak "Cannot update TEXT/IMAGE column(s) without primary key values";
 676   }
 677
 678   for my $col (keys %$blob_cols) {
 679     my $blob = $blob_cols->{$col};
 680
 681     my %where = map { ($_, $row{$_}) } @primary_cols;
 682
 683     my $cursor = $self->select ($source, [$col], \%where, {});
 684     $cursor->next;
 685     my $sth = $cursor->sth;
 686
 687     eval {
 688       do {
 689         $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
 690       } while $sth->fetch;
 691
 692       $sth->func('ct_prepare_send') or die $sth->errstr;
 693
 694       my $log_on_update = $self->_blob_log_on_update;
 695       $log_on_update    = 1 if not defined $log_on_update;
 696
 697       $sth->func('CS_SET', 1, {
 698         total_txtlen => length($blob),
 699         log_on_update => $log_on_update
 700       }, 'ct_data_info') or die $sth->errstr;
 701
 702       $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
 703
 704       $sth->func('ct_finish_send') or die $sth->errstr;
 705     };
 706     my $exception = $@;
 707     $sth->finish if $sth;
 708     if ($exception) {
 709       if ($self->using_freetds) {
 710         croak (
 711           'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
 712           . $exception
 713         );
 714       } else {
 715         croak $exception;
 716       }
 717     }
 718   }
 719 }
 720
 721 =head2 connect_call_datetime_setup
 722
 723 Used as:
 724
 725   on_connect_call => 'datetime_setup'
 726
 727 In L<DBIx::Class::Storage::DBI/connect_info> to set:
 728
 729   $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
 730   $dbh->do('set dateformat mdy');   # input fmt:  08/13/1979 18:08:55.080
 731
 732 On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
 733 L<DateTime::Format::Sybase>, which you will need to install.
 734
 735 This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
 736 C<SMALLDATETIME> columns only have minute precision.
 737
 738 =cut
 739
 740 {
 741   my $old_dbd_warned = 0;
 742
 743   sub connect_call_datetime_setup {
 744     my $self = shift;
 745     my $dbh = $self->_dbh;
 746
 747     if ($dbh->can('syb_date_fmt')) {
 748       # amazingly, this works with FreeTDS
 749       $dbh->syb_date_fmt('ISO_strict');
 750     } elsif (not $old_dbd_warned) {
 751       carp "Your DBD::Sybase is too old to support ".
 752       "DBIx::Class::InflateColumn::DateTime, please upgrade!";
 753       $old_dbd_warned = 1;
 754     }
 755
 756     $dbh->do('SET DATEFORMAT mdy');
 757
 758     1;
 759   }
 760 }
 761
 762 sub datetime_parser_type { "DateTime::Format::Sybase" }
 763
 764 # ->begin_work and such have no effect with FreeTDS but we run them anyway to
 765 # let the DBD keep any state it needs to.
 766 #
 767 # If they ever do start working, the extra statements will do no harm (because
 768 # Sybase supports nested transactions.)
 769
 770 sub _dbh_begin_work {
 771   my $self = shift;
 772
 773 # bulkLogin=1 connections are always in a transaction, and can only call BEGIN
 774 # TRAN once. However, we need to make sure there's a $dbh.
 775   return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work;
 776
 777   $self->next::method(@_);
 778
 779   if ($self->using_freetds) {
 780     $self->_get_dbh->do('BEGIN TRAN');
 781   }
 782
 783   $self->_began_bulk_work(1) if $self->_is_bulk_storage;
 784 }
 785
 786 sub _dbh_commit {
 787   my $self = shift;
 788   if ($self->using_freetds) {
 789     $self->_dbh->do('COMMIT');
 790   }
 791   return $self->next::method(@_);
 792 }
 793
 794 sub _dbh_rollback {
 795   my $self = shift;
 796   if ($self->using_freetds) {
 797     $self->_dbh->do('ROLLBACK');
 798   }
 799   return $self->next::method(@_);
 800 }
 801
 802 # savepoint support using ASE syntax
 803
 804 sub _svp_begin {
 805   my ($self, $name) = @_;
 806
 807   $self->_get_dbh->do("SAVE TRANSACTION $name");
 808 }
 809
 810 # A new SAVE TRANSACTION with the same name releases the previous one.
 811 sub _svp_release { 1 }
 812
 813 sub _svp_rollback {
 814   my ($self, $name) = @_;
 815
 816   $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
 817 }
 818
 819 1;
 820
 821 =head1 Schema::Loader Support
 822
 823 There is an experimental branch of L<DBIx::Class::Schema::Loader> that will
 824 allow you to dump a schema from most (if not all) versions of Sybase.
 825
 826 It is available via subversion from:
 827
 828   http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/
 829
 830 =head1 FreeTDS
 831
 832 This driver supports L<DBD::Sybase> compiled against FreeTDS
 833 (L<http://www.freetds.org/>) to the best of our ability, however it is
 834 recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
 835 libraries. They are a part of the Sybase ASE distribution:
 836
 837 The Open Client FAQ is here:
 838 L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
 839
 840 Sybase ASE for Linux (which comes with the Open Client libraries) may be
 841 downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
 842
 843 To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
 844
 845   perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
 846
 847 Some versions of the libraries involved will not support placeholders, in which
 848 case the storage will be reblessed to
 849 L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>.
 850
 851 In some configurations, placeholders will work but will throw implicit type
 852 conversion errors for anything that's not expecting a string. In such a case,
 853 the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
 854 automatically set, which you may enable on connection with
 855 L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
 856 for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
 857 definitions in your Result classes, and are mapped to a Sybase type (if it isn't
 858 already) using a mapping based on L<SQL::Translator>.
 859
 860 In other configurations, placeholers will work just as they do with the Sybase
 861 Open Client libraries.
 862
 863 Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
 864
 865 =head1 INSERTS WITH PLACEHOLDERS
 866
 867 With placeholders enabled, inserts are done in a transaction so that there are
 868 no concurrency issues with getting the inserted identity value using
 869 C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
 870 mode.
 871
 872 In addition, they are done on a separate connection so that it's possible to
 873 have active cursors when doing an insert.
 874
 875 When using C<DBIx::Class::Storage::DBI::Sybase::NoBindVars> transactions are
 876 disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as it's a
 877 session variable.
 878
 879 =head1 TRANSACTIONS
 880
 881 Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
 882 begin a transaction while there are active cursors. An active cursor is, for
 883 example, a L<ResultSet|DBIx::Class::ResultSet> that has been executed using
 884 C<next> or C<first> but has not been exhausted or
 885 L<reset|DBIx::Class::ResultSet/reset>.
 886
 887 For example, this will not work:
 888
 889   $schema->txn_do(sub {
 890     my $rs = $schema->resultset('Book');
 891     while (my $row = $rs->next) {
 892       $schema->resultset('MetaData')->create({
 893         book_id => $row->id,
 894         ...
 895       });
 896     }
 897   });
 898
 899 Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
 900 are not affected, as they are done on an extra database handle.
 901
 902 Some workarounds:
 903
 904 =over 4
 905
 906 =item * use L<DBIx::Class::Storage::DBI::Replicated>
 907
 908 =item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
 909
 910 =item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
 911
 912 =back
 913
 914 =head1 MAXIMUM CONNECTIONS
 915
 916 The TDS protocol makes separate connections to the server for active statements
 917 in the background. By default the number of such connections is limited to 25,
 918 on both the client side and the server side.
 919
 920 This is a bit too low for a complex L<DBIx::Class> application, so on connection
 921 the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
 922 can override it to whatever setting you like in the DSN.
 923
 924 See
 925 L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
 926 for information on changing the setting on the server side.
 927
 928 =head1 DATES
 929
 930 See L</connect_call_datetime_setup> to setup date formats
 931 for L<DBIx::Class::InflateColumn::DateTime>.
 932
 933 =head1 TEXT/IMAGE COLUMNS
 934
 935 L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
 936 C<TEXT/IMAGE> columns.
 937
 938 Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
 939
 940   $schema->storage->dbh->do("SET TEXTSIZE $bytes");
 941
 942 or
 943
 944   $schema->storage->set_textsize($bytes);
 945
 946 instead.
 947
 948 However, the C<LongReadLen> you pass in
 949 L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
 950 C<SET TEXTSIZE> command on connection.
 951
 952 See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
 953 setting you need to work with C<IMAGE> columns.
 954
 955 =head1 BULK API
 956
 957 The experimental L<DBD::Sybase> Bulk API support is used for
 958 L<populate|DBIx::Class::ResultSet/populate> in B<void> context, in a transaction
 959 on a separate connection.
 960
 961 To use this feature effectively, use a large number of rows for each
 962 L<populate|DBIx::Class::ResultSet/populate> call, eg.:
 963
 964   while (my $rows = $data_source->get_100_rows()) {
 965     $rs->populate($rows);
 966   }
 967
 968 B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
 969 calls in your C<Result> classes B<must> list columns in database order for this
 970 to work. Also, you may have to unset the C<LANG> environment variable before
 971 loading your app, if it doesn't match the character set of your database.
 972
 973 =head1 AUTHOR
 974
 975 See L<DBIx::Class/CONTRIBUTORS>.
 976
 977 =head1 LICENSE
 978
 979 You may distribute this code under the same terms as Perl itself.
 980
 981 =cut
 982 # vim:sts=2 sw=2: