add another test for sybase bulk stuff (passes)
[dbsrgits/DBIx-Class.git] / lib / DBIx / Class / Storage / DBI / Sybase.pm
CommitLineData
3885cff6 1package DBIx::Class::Storage::DBI::Sybase;
2
3use strict;
4use warnings;
2ad62d97 5
eabab5d0 6use base qw/
2f92e90b 7 DBIx::Class::Storage::DBI::Sybase::Common
07a5866e 8 DBIx::Class::Storage::DBI::AutoCast
eabab5d0 9/;
2ad62d97 10use mro 'c3';
6b1f5ef7 11use Carp::Clan qw/^DBIx::Class/;
289877b0 12use List::Util ();
6fcb1409 13use Sub::Name ();
6b1f5ef7 14
285baccb 15__PACKAGE__->mk_group_accessors('simple' =>
c080561b 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
40531ea8 19 _identity_method/
285baccb 20);
21
c080561b 22my @also_proxy_to_extra_storages = qw/
6fcb1409 23 disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
24 auto_savepoint unsafe cursor_class debug debugobj schema
25/;
26
98259fe4 27=head1 NAME
28
928f0af8 29DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class
98259fe4 30
31=head1 SYNOPSIS
32
33This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
34using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
35L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
36
37=head1 DESCRIPTION
38
39If your version of Sybase does not support placeholders, then your storage
40will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
41also enable that driver explicitly, see the documentation for more details.
42
43With this driver there is unfortunately no way to get the C<last_insert_id>
310a0a0a 44without doing a C<SELECT MAX(col)>. This is done safely in a transaction
322b7a6b 45(locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
98259fe4 46
61cfaef7 47A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
98259fe4 48
61cfaef7 49 on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
98259fe4 50
51=head1 METHODS
52
53=cut
54
47d9646a 55sub _rebless {
b50a5275 56 my $self = shift;
c5ce7cd6 57
58 if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
59 my $dbtype = eval {
2eef8633 60 @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
c5ce7cd6 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;
5703eb14 70 } else { # real Sybase
71 my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
72
e97a6ee2 73 if ($self->using_freetds) {
a3a526cc 74 carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
75
76You are using FreeTDS with Sybase.
5703eb14 77
a3a526cc 78We will do our best to support this configuration, but please consider this
79support experimental.
5703eb14 80
a3a526cc 81TEXT/IMAGE columns will definitely not work.
8c4b6c50 82
e97a6ee2 83You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
a3a526cc 84instead.
5703eb14 85
86See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
a3a526cc 87
88To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
89variable.
5703eb14 90EOF
70ced519 91 if (not $self->_typeless_placeholders_supported) {
92 if ($self->_placeholders_supported) {
e97a6ee2 93 $self->auto_cast(1);
a3a526cc 94 } else {
95 $self->ensure_class_loaded($no_bind_vars);
96 bless $self, $no_bind_vars;
97 $self->_rebless;
98 }
99 }
0ac07712 100 }
75227502 101 elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
0ac07712 102 # not necessarily FreeTDS, but no placeholders nevertheless
61cfaef7 103 $self->ensure_class_loaded($no_bind_vars);
104 bless $self, $no_bind_vars;
105 $self->_rebless;
310a0a0a 106 } elsif (not $self->_typeless_placeholders_supported) {
c080561b 107 # this is highly unlikely, but we check just in case
310a0a0a 108 $self->auto_cast(1);
61cfaef7 109 }
47d9646a 110 }
c5ce7cd6 111 }
b50a5275 112}
113
37b17a93 114sub _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;
6fcb1409 120
d69a17c8 121# create storage for insert/(update blob) transactions,
122# unless this is that storage
c080561b 123 return if $self->_is_extra_storage;
6fcb1409 124
d69a17c8 125 my $writer_storage = (ref $self)->new;
40531ea8 126
c080561b 127 $writer_storage->_is_extra_storage(1);
d69a17c8 128 $writer_storage->connect_info($self->connect_info);
40531ea8 129
d69a17c8 130 $self->_writer_storage($writer_storage);
c080561b 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);
6fcb1409 146}
147
c080561b 148for my $method (@also_proxy_to_extra_storages) {
6fcb1409 149 no strict 'refs';
c080561b 150 no warnings 'redefine';
6fcb1409 151
d69a17c8 152 my $replaced = __PACKAGE__->can($method);
153
c080561b 154 *{$method} = Sub::Name::subname $method => sub {
6fcb1409 155 my $self = shift;
d69a17c8 156 $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
c080561b 157 $self->_bulk_storage->$replaced(@_) if $self->_bulk_storage;
d69a17c8 158 return $self->$replaced(@_);
6fcb1409 159 };
37b17a93 160}
161
c080561b 162sub 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
a3a526cc 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.
f6de7111 183sub _populate_dbh {
184 my $self = shift;
41c93b1b 185
a3a526cc 186 $self->next::method(@_);
c080561b 187
188 if ($self->_is_bulk_storage) {
189# this should be cleared on every reconnect
190 $self->_began_bulk_work(0);
191 return;
192 }
41c93b1b 193
e97a6ee2 194 if (not $self->using_freetds) {
a3a526cc 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 }
41c93b1b 202 }
203}
204
63d46bb3 205=head2 connect_call_blob_setup
206
207Used as:
208
61cfaef7 209 on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
63d46bb3 210
211Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
212instead of as a hex string.
213
6636ad53 214Recommended.
215
fd5a07e4 216Also sets the C<log_on_update> value for blob write operations. The default is
217C<1>, but C<0> is better if your database is configured for it.
218
219See
220L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
221
63d46bb3 222=cut
223
224sub connect_call_blob_setup {
225 my $self = shift;
fd5a07e4 226 my %args = @_;
63d46bb3 227 my $dbh = $self->_dbh;
228 $dbh->{syb_binary_images} = 1;
fd5a07e4 229
230 $self->_blob_log_on_update($args{log_on_update})
231 if exists $args{log_on_update};
232}
233
234sub _is_lob_type {
235 my $self = shift;
5703eb14 236 my $type = shift;
078a332f 237 $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
fd5a07e4 238}
239
285baccb 240sub _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') {
285baccb 247 my $table = $ident->from;
248
a3a526cc 249 my $bind_info = $self->_resolve_column_info(
250 $ident, [map $_->[0], @{$bind}]
251 );
0ac07712 252 my $identity_col = List::Util::first
253 { $bind_info->{$_}{is_auto_increment} }
254 (keys %$bind_info)
255 ;
285baccb 256
257 if ($identity_col) {
0ac07712 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 ;
285baccb 269 }
270
271 if ($identity_col) {
285baccb 272 $sql =
285baccb 273 "$sql\n" .
a3a526cc 274 $self->_fetch_identity_sql($ident, $identity_col);
285baccb 275 }
276 }
277
278 return ($sql, $bind);
279}
280
0ac07712 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.
284our %TYPE_MAPPING = (
a3a526cc 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
07a5866e 302sub _native_data_type {
a3a526cc 303 my ($self, $type) = @_;
304
305 $type = lc $type;
c9d9c670 306 $type =~ s/\s* identity//x;
a3a526cc 307
308 return uc($TYPE_MAPPING{$type} || $type);
309}
310
285baccb 311sub _fetch_identity_sql {
312 my ($self, $source, $col) = @_;
313
c453ddd9 314 return sprintf ("SELECT MAX(%s) FROM %s",
315 map { $self->sql_maker->_quote ($_) } ($col, $source->from)
316 );
285baccb 317}
318
319sub _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
333sub last_insert_id { shift->_identity }
334
aee988d2 335# handles TEXT/IMAGE and transaction for last_insert_id
fd5a07e4 336sub insert {
0ac07712 337 my $self = shift;
58e3556d 338 my ($source, $to_insert) = @_;
7d17f469 339
340 my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
341
c453ddd9 342 my $identity_col = List::Util::first
343 { $source->column_info($_)->{is_auto_increment} }
344 $source->columns;
322b7a6b 345
c453ddd9 346 # do we need the horrific SELECT MAX(COL) hack?
347 my $dumb_last_insert_id =
6fcb1409 348 $identity_col
349 && (not exists $to_insert->{$identity_col})
350 && ($self->_identity_method||'') ne '@@IDENTITY';
c453ddd9 351
759ca0fe 352 my $next = $self->next::can;
353
c453ddd9 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 ) {
759ca0fe 359 return $self->_insert (
961a1383 360 $next, $source, $to_insert, $blob_cols, $identity_col
759ca0fe 361 );
c453ddd9 362 }
322b7a6b 363
d69a17c8 364 # otherwise use the _writer_storage to do the insert+transaction on another
6fcb1409 365 # connection
d69a17c8 366 my $guard = $self->_writer_storage->txn_scope_guard;
310a0a0a 367
d69a17c8 368 my $updated_cols = $self->_writer_storage->_insert (
961a1383 369 $next, $source, $to_insert, $blob_cols, $identity_col
759ca0fe 370 );
322b7a6b 371
d69a17c8 372 $self->_identity($self->_writer_storage->_identity);
6fcb1409 373
c453ddd9 374 $guard->commit;
322b7a6b 375
c453ddd9 376 return $updated_cols;
c453ddd9 377}
7d17f469 378
c453ddd9 379sub _insert {
961a1383 380 my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
7d17f469 381
759ca0fe 382 my $updated_cols = $self->$next ($source, $to_insert);
c453ddd9 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;
aee988d2 391
7d17f469 392 return $updated_cols;
393}
394
078a332f 395sub update {
0ac07712 396 my $self = shift;
5370e479 397 my ($source, $fields, $where) = @_;
0ac07712 398
399 my $wantarray = wantarray;
078a332f 400 my $blob_cols = $self->_remove_blob_cols($source, $fields);
401
961a1383 402 if (not $blob_cols) {
403 return $self->next::method(@_);
404 }
405
6fcb1409 406# update+blob update(s) done atomically on separate connection
d69a17c8 407 $self = $self->_writer_storage;
961a1383 408
961a1383 409 my $guard = $self->txn_scope_guard;
410
078a332f 411 my @res;
412 if ($wantarray) {
0ac07712 413 @res = $self->next::method(@_);
414 }
415 elsif (defined $wantarray) {
416 $res[0] = $self->next::method(@_);
417 }
418 else {
419 $self->next::method(@_);
078a332f 420 }
421
961a1383 422 $self->_update_blobs($source, $blob_cols, $where);
078a332f 423
961a1383 424 $guard->commit;
aee988d2 425
078a332f 426 return $wantarray ? @res : $res[0];
427}
7d17f469 428
c080561b 429### the insert_bulk partially stolen from DBI/MSSQL.pm
40531ea8 430
431sub _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
449sub _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
c080561b 461## XXX add blob support
40531ea8 462sub insert_bulk {
463 my $self = shift;
464 my ($source, $cols, $data) = @_;
465
466 my $is_identity_insert = (List::Util::first
c080561b 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 $self->_bulk_disabled_due_to_coderef_connect_info_warned) {
479 carp <<'EOF';
480Bulk API support disabled due to use of a CODEREF connect_info. Reverting to
481array inserts.
482EOF
483 $self->_bulk_disabled_due_to_coderef_connect_info_warned(1);
40531ea8 484 }
485
c080561b 486 if (not $use_bulk_api) {
487 if ($is_identity_insert) {
488 $self->_set_identity_insert ($source->name);
489 }
490
491 $self->next::method(@_);
40531ea8 492
c080561b 493 if ($is_identity_insert) {
494 $self->_unset_identity_insert ($source->name);
495 }
496
497 return;
40531ea8 498 }
40531ea8 499
c080561b 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
594Sybase bulk API operation failed due to character set incompatibility, reverting
595to regular array inserts:
596
597*** Try unsetting the LANG environment variable.
598
599$@
600EOF
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}
40531ea8 615
7d17f469 616sub _remove_blob_cols {
617 my ($self, $source, $fields) = @_;
fd5a07e4 618
619 my %blob_cols;
620
7d17f469 621 for my $col (keys %$fields) {
9b3dabe0 622 if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
623 $blob_cols{$col} = delete $fields->{$col};
624 $fields->{$col} = \"''";
625 }
fd5a07e4 626 }
627
c966cf1b 628 return keys %blob_cols ? \%blob_cols : undef;
fd5a07e4 629}
630
631sub _update_blobs {
5370e479 632 my ($self, $source, $blob_cols, $where) = @_;
078a332f 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) {
5370e479 642 $pk_cols_in_where++ if defined $where->{$col};
078a332f 643 }
644 my @rows;
645
646 if ($pk_cols_in_where == @primary_cols) {
647 my %row_to_update;
5370e479 648 @row_to_update{@primary_cols} = @{$where}{@primary_cols};
078a332f 649 @rows = \%row_to_update;
650 } else {
6fcb1409 651 my $cursor = $self->select ($source, \@primary_cols, $where, {});
652 @rows = map {
653 my %row; @row{@primary_cols} = @$_; \%row
654 } $cursor->all;
078a332f 655 }
656
657 for my $row (@rows) {
658 $self->_insert_blobs($source, $blob_cols, $row);
659 }
660}
661
662sub _insert_blobs {
663 my ($self, $source, $blob_cols, $row) = @_;
75227502 664 my $dbh = $self->_get_dbh;
fd5a07e4 665
666 my $table = $source->from;
667
078a332f 668 my %row = %$row;
fd5a07e4 669 my (@primary_cols) = $source->primary_columns;
670
9b3dabe0 671 croak "Cannot update TEXT/IMAGE column(s) without a primary key"
fd5a07e4 672 unless @primary_cols;
673
078a332f 674 if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) {
c453ddd9 675 croak "Cannot update TEXT/IMAGE column(s) without primary key values";
9b3dabe0 676 }
fd5a07e4 677
678 for my $col (keys %$blob_cols) {
679 my $blob = $blob_cols->{$col};
680
a3a526cc 681 my %where = map { ($_, $row{$_}) } @primary_cols;
6fcb1409 682
683 my $cursor = $self->select ($source, [$col], \%where, {});
a3a526cc 684 $cursor->next;
5137d252 685 my $sth = $cursor->sth;
fd5a07e4 686
687 eval {
a3a526cc 688 do {
fd5a07e4 689 $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
a3a526cc 690 } while $sth->fetch;
691
fd5a07e4 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 = $@;
a3a526cc 707 $sth->finish if $sth;
708 if ($exception) {
e97a6ee2 709 if ($self->using_freetds) {
0ac07712 710 croak (
711 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
712 . $exception
713 );
a3a526cc 714 } else {
715 croak $exception;
716 }
717 }
fd5a07e4 718 }
63d46bb3 719}
720
9539eeb1 721=head2 connect_call_datetime_setup
722
723Used as:
724
725 on_connect_call => 'datetime_setup'
726
727In L<DBIx::Class::Storage::DBI/connect_info> to set:
728
3abafb11 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
9539eeb1 731
732On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
3abafb11 733L<DateTime::Format::Sybase>, which you will need to install.
734
735This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
736C<SMALLDATETIME> columns only have minute precision.
9539eeb1 737
738=cut
739
9041a97a 740{
741 my $old_dbd_warned = 0;
742
9539eeb1 743 sub connect_call_datetime_setup {
6b1f5ef7 744 my $self = shift;
6b1f5ef7 745 my $dbh = $self->_dbh;
746
747 if ($dbh->can('syb_date_fmt')) {
0ac07712 748 # amazingly, this works with FreeTDS
6b1f5ef7 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
e97a6ee2 756 $dbh->do('SET DATEFORMAT mdy');
c5ce7cd6 757
6b1f5ef7 758 1;
c5ce7cd6 759 }
6b1f5ef7 760}
761
6636ad53 762sub datetime_parser_type { "DateTime::Format::Sybase" }
763
e97a6ee2 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.)
a3a526cc 769
770sub _dbh_begin_work {
771 my $self = shift;
c080561b 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
e97a6ee2 777 $self->next::method(@_);
c080561b 778
e97a6ee2 779 if ($self->using_freetds) {
75227502 780 $self->_get_dbh->do('BEGIN TRAN');
a3a526cc 781 }
c080561b 782
783 $self->_began_bulk_work(1) if $self->_is_bulk_storage;
a3a526cc 784}
785
786sub _dbh_commit {
787 my $self = shift;
e97a6ee2 788 if ($self->using_freetds) {
a3a526cc 789 $self->_dbh->do('COMMIT');
790 }
e97a6ee2 791 return $self->next::method(@_);
a3a526cc 792}
793
794sub _dbh_rollback {
795 my $self = shift;
e97a6ee2 796 if ($self->using_freetds) {
a3a526cc 797 $self->_dbh->do('ROLLBACK');
798 }
e97a6ee2 799 return $self->next::method(@_);
a3a526cc 800}
801
1816be4f 802# savepoint support using ASE syntax
803
804sub _svp_begin {
805 my ($self, $name) = @_;
806
75227502 807 $self->_get_dbh->do("SAVE TRANSACTION $name");
1816be4f 808}
809
810# A new SAVE TRANSACTION with the same name releases the previous one.
811sub _svp_release { 1 }
812
813sub _svp_rollback {
814 my ($self, $name) = @_;
815
75227502 816 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
1816be4f 817}
818
3885cff6 8191;
820
efe75aaa 821=head1 Schema::Loader Support
822
823There is an experimental branch of L<DBIx::Class::Schema::Loader> that will
824allow you to dump a schema from most (if not all) versions of Sybase.
825
826It is available via subversion from:
827
07a5866e 828 http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/
efe75aaa 829
e97a6ee2 830=head1 FreeTDS
831
832This driver supports L<DBD::Sybase> compiled against FreeTDS
833(L<http://www.freetds.org/>) to the best of our ability, however it is
834recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
835libraries. They are a part of the Sybase ASE distribution:
836
837The Open Client FAQ is here:
838L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
839
840Sybase ASE for Linux (which comes with the Open Client libraries) may be
841downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
842
843To 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
847Some versions of the libraries involved will not support placeholders, in which
848case the storage will be reblessed to
849L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>.
850
07a5866e 851In some configurations, placeholders will work but will throw implicit type
e97a6ee2 852conversion errors for anything that's not expecting a string. In such a case,
07a5866e 853the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
854automatically set, which you may enable on connection with
855L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
856for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
857definitions in your Result classes, and are mapped to a Sybase type (if it isn't
858already) using a mapping based on L<SQL::Translator>.
e97a6ee2 859
860In other configurations, placeholers will work just as they do with the Sybase
861Open Client libraries.
862
863Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
864
322b7a6b 865=head1 INSERTS WITH PLACEHOLDERS
866
867With placeholders enabled, inserts are done in a transaction so that there are
868no concurrency issues with getting the inserted identity value using
869C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
870mode.
871
6fcb1409 872In addition, they are done on a separate connection so that it's possible to
873have active cursors when doing an insert.
874
322b7a6b 875When using C<DBIx::Class::Storage::DBI::Sybase::NoBindVars> transactions are
876disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as it's a
877session variable.
878
166c6561 879=head1 TRANSACTIONS
880
881Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
882begin a transaction while there are active cursors. An active cursor is, for
883example, a L<ResultSet|DBIx::Class::ResultSet> that has been executed using
884C<next> or C<first> but has not been exhausted or
75227502 885L<reset|DBIx::Class::ResultSet/reset>.
166c6561 886
322b7a6b 887For 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
166c6561 899Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
6fcb1409 900are not affected, as they are done on an extra database handle.
75227502 901
902Some workarounds:
903
904=over 4
905
75227502 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
75227502 912=back
166c6561 913
41c93b1b 914=head1 MAXIMUM CONNECTIONS
915
e97a6ee2 916The TDS protocol makes separate connections to the server for active statements
917in the background. By default the number of such connections is limited to 25,
918on both the client side and the server side.
41c93b1b 919
e97a6ee2 920This is a bit too low for a complex L<DBIx::Class> application, so on connection
921the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
922can override it to whatever setting you like in the DSN.
41c93b1b 923
924See
925L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
926for information on changing the setting on the server side.
927
c5ce7cd6 928=head1 DATES
929
3abafb11 930See L</connect_call_datetime_setup> to setup date formats
931for L<DBIx::Class::InflateColumn::DateTime>.
c5ce7cd6 932
e97a6ee2 933=head1 TEXT/IMAGE COLUMNS
63d46bb3 934
a3a526cc 935L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
936C<TEXT/IMAGE> columns.
937
e97a6ee2 938Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
939
940 $schema->storage->dbh->do("SET TEXTSIZE $bytes");
a3a526cc 941
e97a6ee2 942or
943
944 $schema->storage->set_textsize($bytes);
a3a526cc 945
946instead.
5703eb14 947
e97a6ee2 948However, the C<LongReadLen> you pass in
949L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
950C<SET TEXTSIZE> command on connection.
951
63d46bb3 952See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
953setting you need to work with C<IMAGE> columns.
954
c080561b 955=head1 BULK API
956
957The experimental L<DBD::Sybase> Bulk API support is used for
958L<populate|DBIx::Class::ResultSet/populate> in B<void> context, in a transaction
959on a separate connection.
960
961To use this feature effectively, use a large number of rows for each
962L<populate|DBIx::Class::ResultSet/populate> call, eg.:
963
964 while (my $rows = $data_source->get_100_rows()) {
965 $rs->populate($rows);
966 }
967
968B<NOTE:> the L<add_columns|DBIx::Class::ResultSource/add_columns>
969calls in your C<Result> classes B<must> list columns in database order for this
970to work. Also, you may have to unset the C<LANG> environment variable before
971loading your app, if it doesn't match the character set of your database.
972
58e3556d 973=head1 AUTHOR
3885cff6 974
7e8cecc1 975See L<DBIx::Class/CONTRIBUTORS>.
c5ce7cd6 976
3885cff6 977=head1 LICENSE
978
979You may distribute this code under the same terms as Perl itself.
980
981=cut
c5ce7cd6 982# vim:sts=2 sw=2: