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