1 package DBIx::Class::Storage::DBI::Sybase;
7 DBIx::Class::Storage::DBI::Sybase::Common
8 DBIx::Class::Storage::DBI::AutoCast
11 use Carp::Clan qw/^DBIx::Class/;
15 __PACKAGE__->mk_group_accessors('simple' =>
16 qw/_identity _blob_log_on_update _writer_storage _is_writer_storage
20 my @also_proxy_to_writer_storage = qw/
21 disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
22 auto_savepoint unsafe cursor_class debug debugobj schema
27 DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class
31 This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
32 using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
33 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
37 If your version of Sybase does not support placeholders, then your storage
38 will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
39 also enable that driver explicitly, see the documentation for more details.
41 With this driver there is unfortunately no way to get the C<last_insert_id>
42 without doing a C<SELECT MAX(col)>. This is done safely in a transaction
43 (locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
45 A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
47 on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
56 if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
58 @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
63 my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
65 if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
66 bless $self, $subclass;
68 } else { # real Sybase
69 my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
71 if ($self->using_freetds) {
72 carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
74 You are using FreeTDS with Sybase.
76 We will do our best to support this configuration, but please consider this
79 TEXT/IMAGE columns will definitely not work.
81 You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
84 See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
86 To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
89 if (not $self->_typeless_placeholders_supported) {
90 if ($self->_placeholders_supported) {
93 $self->ensure_class_loaded($no_bind_vars);
94 bless $self, $no_bind_vars;
99 elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
100 # not necessarily FreeTDS, but no placeholders nevertheless
101 $self->ensure_class_loaded($no_bind_vars);
102 bless $self, $no_bind_vars;
104 } elsif (not $self->_typeless_placeholders_supported) {
105 # this is highly unlikely, but we check just in case
114 $self->_set_max_connect(256);
116 # based on LongReadLen in connect_info
117 $self->set_textsize if $self->using_freetds;
119 # create storage for insert/(update blob) transactions,
120 # unless this is that storage
121 return if $self->_is_writer_storage;
123 my $writer_storage = (ref $self)->new;
125 $writer_storage->_is_writer_storage(1);
126 $writer_storage->connect_info($self->connect_info);
128 $self->_writer_storage($writer_storage);
131 for my $method (@also_proxy_to_writer_storage) {
134 my $replaced = __PACKAGE__->can($method);
136 *{$method} = Sub::Name::subname __PACKAGE__."::$method" => sub {
138 $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
139 return $self->$replaced(@_);
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.
150 $self->next::method(@_);
152 if (not $self->using_freetds) {
153 $self->_dbh->{syb_chained_txn} = 1;
155 if ($self->_dbh_autocommit) {
156 $self->_dbh->do('SET CHAINED OFF');
158 $self->_dbh->do('SET CHAINED ON');
163 =head2 connect_call_blob_setup
167 on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
169 Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
170 instead of as a hex string.
174 Also sets the C<log_on_update> value for blob write operations. The default is
175 C<1>, but C<0> is better if your database is configured for it.
178 L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
182 sub connect_call_blob_setup {
185 my $dbh = $self->_dbh;
186 $dbh->{syb_binary_images} = 1;
188 $self->_blob_log_on_update($args{log_on_update})
189 if exists $args{log_on_update};
195 $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
199 my ($self, $source, $column) = @_;
201 return $self->_is_lob_type($source->column_info($column)->{data_type});
204 sub _prep_for_execute {
206 my ($op, $extra_bind, $ident, $args) = @_;
208 my ($sql, $bind) = $self->next::method (@_);
210 if ($op eq 'insert') {
211 my $table = $ident->from;
213 my $bind_info = $self->_resolve_column_info(
214 $ident, [map $_->[0], @{$bind}]
216 my $identity_col = List::Util::first
217 { $bind_info->{$_}{is_auto_increment} }
223 "SET IDENTITY_INSERT $table ON",
225 "SET IDENTITY_INSERT $table OFF",
229 $identity_col = List::Util::first
230 { $ident->column_info($_)->{is_auto_increment} }
238 $self->_fetch_identity_sql($ident, $identity_col);
242 return ($sql, $bind);
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.
248 our %TYPE_MAPPING = (
251 varchar => 'varchar',
252 varchar2 => 'varchar',
253 timestamp => 'datetime',
255 real => 'double precision',
258 tinyint => 'smallint',
259 float => 'double precision',
261 bigserial => 'numeric',
262 boolean => 'varchar',
266 sub _native_data_type {
267 my ($self, $type) = @_;
270 $type =~ s/\s* identity//x;
272 return uc($TYPE_MAPPING{$type} || $type);
275 sub _fetch_identity_sql {
276 my ($self, $source, $col) = @_;
278 return sprintf ("SELECT MAX(%s) FROM %s",
279 map { $self->sql_maker->_quote ($_) } ($col, $source->from)
287 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
289 if ($op eq 'insert') {
290 $self->_identity($sth->fetchrow_array);
294 return wantarray ? ($rv, $sth, @bind) : $rv;
297 sub last_insert_id { shift->_identity }
299 # handles TEXT/IMAGE and transaction for last_insert_id
302 my ($source, $to_insert) = @_;
304 my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
306 my $identity_col = List::Util::first
307 { $source->column_info($_)->{is_auto_increment} }
310 # do we need the horrific SELECT MAX(COL) hack?
311 my $dumb_last_insert_id =
313 && (not exists $to_insert->{$identity_col})
314 && ($self->_identity_method||'') ne '@@IDENTITY';
316 my $next = $self->next::can;
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)
323 return $self->_insert (
324 $next, $source, $to_insert, $blob_cols, $identity_col
328 # otherwise use the _writer_storage to do the insert+transaction on another
330 my $guard = $self->_writer_storage->txn_scope_guard;
332 my $updated_cols = $self->_writer_storage->_insert (
333 $next, $source, $to_insert, $blob_cols, $identity_col
336 $self->_identity($self->_writer_storage->_identity);
340 return $updated_cols;
344 my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
346 my $updated_cols = $self->$next ($source, $to_insert);
349 $identity_col => $self->last_insert_id($source, $identity_col),
354 $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
356 return $updated_cols;
361 my ($source, $fields, $where, @rest) = @_;
363 my $wantarray = wantarray;
365 my $blob_cols = $self->_remove_blob_cols($source, $fields);
367 my $table = $source->name;
369 my $identity_col = List::Util::first
370 { $source->column_info($_)->{is_auto_increment} }
373 my $is_identity_update = $identity_col && defined $fields->{$identity_col};
375 if (not $blob_cols) {
376 $self->_set_identity_insert($table, 'update') if $is_identity_update;
377 return $self->next::method(@_);
378 $self->_unset_identity_insert($table, 'update') if $is_identity_update;
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}) {
385 'Update of TEXT/IMAGE column that is also in search condition impossible';
389 # update+blob update(s) done atomically on separate connection
390 $self = $self->_writer_storage;
392 my $guard = $self->txn_scope_guard;
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;
398 $self->next::method($source, \%blobs_to_empty, $where, @rest);
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);
406 $self->_set_identity_insert($table, 'update') if $is_identity_update;
409 @res = $self->next::method(@_);
411 elsif (defined $wantarray) {
412 $res[0] = $self->next::method(@_);
415 $self->next::method(@_);
418 $self->_unset_identity_insert($table, 'update') if $is_identity_update;
423 return $wantarray ? @res : $res[0];
426 ### the insert_bulk stuff stolen from DBI/MSSQL.pm
428 sub _set_identity_insert {
429 my ($self, $table, $op) = @_;
432 'SET IDENTITY_%s %s ON',
433 (uc($op) || 'INSERT'),
434 $self->sql_maker->_quote ($table),
437 $self->_query_start($sql);
439 my $dbh = $self->_get_dbh;
440 eval { $dbh->do ($sql) };
443 $self->_query_end($sql);
446 $self->throw_exception (sprintf "Error executing '%s': %s",
453 sub _unset_identity_insert {
454 my ($self, $table, $op) = @_;
457 'SET IDENTITY_%s %s OFF',
458 (uc($op) || 'INSERT'),
459 $self->sql_maker->_quote ($table),
462 $self->_query_start($sql);
464 my $dbh = $self->_get_dbh;
467 $self->_query_end($sql);
470 # XXX this should use the DBD::Sybase bulk API, where possible
473 my ($source, $cols, $data) = @_;
475 my $is_identity_insert = (List::Util::first
476 { $source->column_info ($_)->{is_auto_increment} }
482 if ($is_identity_insert) {
483 $self->_set_identity_insert ($source->name);
486 $self->next::method(@_);
488 if ($is_identity_insert) {
489 $self->_unset_identity_insert ($source->name);
493 ### end of stolen insert_bulk section
495 # Make sure blobs are not bound as placeholders, and return any non-empty ones
497 sub _remove_blob_cols {
498 my ($self, $source, $fields) = @_;
502 for my $col (keys %$fields) {
503 if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
504 my $blob_val = delete $fields->{$col};
505 if (not defined $blob_val) {
506 $fields->{$col} = \'NULL';
509 $fields->{$col} = \"''";
510 $blob_cols{$col} = $blob_val unless $blob_val eq '';
515 return keys %blob_cols ? \%blob_cols : undef;
519 my ($self, $source, $blob_cols, $where) = @_;
521 my (@primary_cols) = $source->primary_columns;
523 croak "Cannot update TEXT/IMAGE column(s) without a primary key"
524 unless @primary_cols;
526 # check if we're updating a single row by PK
527 my $pk_cols_in_where = 0;
528 for my $col (@primary_cols) {
529 $pk_cols_in_where++ if defined $where->{$col};
533 if ($pk_cols_in_where == @primary_cols) {
535 @row_to_update{@primary_cols} = @{$where}{@primary_cols};
536 @rows = \%row_to_update;
538 my $cursor = $self->select ($source, \@primary_cols, $where, {});
540 my %row; @row{@primary_cols} = @$_; \%row
544 for my $row (@rows) {
545 $self->_insert_blobs($source, $blob_cols, $row);
550 my ($self, $source, $blob_cols, $row) = @_;
551 my $dbh = $self->_get_dbh;
553 my $table = $source->name;
556 my (@primary_cols) = $source->primary_columns;
558 croak "Cannot update TEXT/IMAGE column(s) without a primary key"
559 unless @primary_cols;
561 if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) {
562 croak "Cannot update TEXT/IMAGE column(s) without primary key values";
565 for my $col (keys %$blob_cols) {
566 my $blob = $blob_cols->{$col};
568 my %where = map { ($_, $row{$_}) } @primary_cols;
570 my $cursor = $self->select ($source, [$col], \%where, {});
572 my $sth = $cursor->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;
582 croak "\nCould not find row in table '$table' for blob update:\n".
583 Data::Dumper::Dumper(\%where)."\n";
588 $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
591 $sth->func('ct_prepare_send') or die $sth->errstr;
593 my $log_on_update = $self->_blob_log_on_update;
594 $log_on_update = 1 if not defined $log_on_update;
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;
601 $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
603 $sth->func('ct_finish_send') or die $sth->errstr;
606 $sth->finish if $sth;
608 if ($self->using_freetds) {
610 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
620 =head2 connect_call_datetime_setup
624 on_connect_call => 'datetime_setup'
626 In L<DBIx::Class::Storage::DBI/connect_info> to set:
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
631 On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
632 L<DateTime::Format::Sybase>, which you will need to install.
634 This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
635 C<SMALLDATETIME> columns only have minute precision.
640 my $old_dbd_warned = 0;
642 sub connect_call_datetime_setup {
644 my $dbh = $self->_dbh;
646 if ($dbh->can('syb_date_fmt')) {
647 # amazingly, this works with FreeTDS
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!";
655 $dbh->do('SET DATEFORMAT mdy');
661 sub datetime_parser_type { "DateTime::Format::Sybase" }
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.
666 # If they ever do start working, the extra statements will do no harm (because
667 # Sybase supports nested transactions.)
669 sub _dbh_begin_work {
671 $self->next::method(@_);
672 if ($self->using_freetds) {
673 $self->_get_dbh->do('BEGIN TRAN');
679 if ($self->using_freetds) {
680 $self->_dbh->do('COMMIT');
682 return $self->next::method(@_);
687 if ($self->using_freetds) {
688 $self->_dbh->do('ROLLBACK');
690 return $self->next::method(@_);
693 # savepoint support using ASE syntax
696 my ($self, $name) = @_;
698 $self->_get_dbh->do("SAVE TRANSACTION $name");
701 # A new SAVE TRANSACTION with the same name releases the previous one.
702 sub _svp_release { 1 }
705 my ($self, $name) = @_;
707 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
712 =head1 Schema::Loader Support
714 There is an experimental branch of L<DBIx::Class::Schema::Loader> that will
715 allow you to dump a schema from most (if not all) versions of Sybase.
717 It is available via subversion from:
719 http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/
723 This driver supports L<DBD::Sybase> compiled against FreeTDS
724 (L<http://www.freetds.org/>) to the best of our ability, however it is
725 recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
726 libraries. They are a part of the Sybase ASE distribution:
728 The Open Client FAQ is here:
729 L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
731 Sybase ASE for Linux (which comes with the Open Client libraries) may be
732 downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
734 To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
736 perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
738 Some versions of the libraries involved will not support placeholders, in which
739 case the storage will be reblessed to
740 L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>.
742 In some configurations, placeholders will work but will throw implicit type
743 conversion errors for anything that's not expecting a string. In such a case,
744 the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
745 automatically set, which you may enable on connection with
746 L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
747 for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
748 definitions in your Result classes, and are mapped to a Sybase type (if it isn't
749 already) using a mapping based on L<SQL::Translator>.
751 In other configurations, placeholers will work just as they do with the Sybase
752 Open Client libraries.
754 Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
756 =head1 INSERTS WITH PLACEHOLDERS
758 With placeholders enabled, inserts are done in a transaction so that there are
759 no concurrency issues with getting the inserted identity value using
760 C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
763 In addition, they are done on a separate connection so that it's possible to
764 have active cursors when doing an insert.
766 When using C<DBIx::Class::Storage::DBI::Sybase::NoBindVars> transactions are
767 disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as it's a
772 Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
773 begin a transaction while there are active cursors. An active cursor is, for
774 example, a L<ResultSet|DBIx::Class::ResultSet> that has been executed using
775 C<next> or C<first> but has not been exhausted or
776 L<reset|DBIx::Class::ResultSet/reset>.
778 For example, this will not work:
780 $schema->txn_do(sub {
781 my $rs = $schema->resultset('Book');
782 while (my $row = $rs->next) {
783 $schema->resultset('MetaData')->create({
790 Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
791 are not affected, as they are done on an extra database handle.
797 =item * use L<DBIx::Class::Storage::DBI::Replicated>
799 =item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
801 =item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
805 =head1 MAXIMUM CONNECTIONS
807 The TDS protocol makes separate connections to the server for active statements
808 in the background. By default the number of such connections is limited to 25,
809 on both the client side and the server side.
811 This is a bit too low for a complex L<DBIx::Class> application, so on connection
812 the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
813 can override it to whatever setting you like in the DSN.
816 L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
817 for information on changing the setting on the server side.
821 See L</connect_call_datetime_setup> to setup date formats
822 for L<DBIx::Class::InflateColumn::DateTime>.
824 =head1 TEXT/IMAGE COLUMNS
826 L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
827 C<TEXT/IMAGE> columns.
829 Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
831 $schema->storage->dbh->do("SET TEXTSIZE $bytes");
835 $schema->storage->set_textsize($bytes);
839 However, the C<LongReadLen> you pass in
840 L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
841 C<SET TEXTSIZE> command on connection.
843 See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
844 setting you need to work with C<IMAGE> columns.
848 See L<DBIx::Class/CONTRIBUTORS>.
852 You may distribute this code under the same terms as Perl itself.