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