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 connect_call_set_auto_cast auto_cast connect_call_blob_setup
22 connect_call_datetime_setup
24 disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching
25 auto_savepoint unsafe cursor_class debug debugobj schema
30 DBIx::Class::Storage::DBI::Sybase - Sybase support for DBIx::Class
34 This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
35 using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
36 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
40 If your version of Sybase does not support placeholders, then your storage
41 will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
42 also enable that driver explicitly, see the documentation for more details.
44 With this driver there is unfortunately no way to get the C<last_insert_id>
45 without doing a C<SELECT MAX(col)>. This is done safely in a transaction
46 (locking the table.) See L</INSERTS WITH PLACEHOLDERS>.
48 A recommended L<DBIx::Class::Storage::DBI/connect_info> setting:
50 on_connect_call => [['datetime_setup'], ['blob_setup', log_on_update => 0]]
59 if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
61 @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
66 my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
68 if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
69 bless $self, $subclass;
71 } else { # real Sybase
72 my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
74 if ($self->using_freetds) {
75 carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
77 You are using FreeTDS with Sybase.
79 We will do our best to support this configuration, but please consider this
82 TEXT/IMAGE columns will definitely not work.
84 You are encouraged to recompile DBD::Sybase with the Sybase Open Client libraries
87 See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
89 To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
92 if (not $self->_typeless_placeholders_supported) {
93 if ($self->_placeholders_supported) {
96 $self->ensure_class_loaded($no_bind_vars);
97 bless $self, $no_bind_vars;
102 elsif (not $self->_get_dbh->{syb_dynamic_supported}) {
103 # not necessarily FreeTDS, but no placeholders nevertheless
104 $self->ensure_class_loaded($no_bind_vars);
105 bless $self, $no_bind_vars;
107 } elsif (not $self->_typeless_placeholders_supported) {
108 # this is highly unlikely, but we check just in case
117 $self->_set_max_connect(256);
119 # based on LongReadLen in connect_info
120 $self->set_textsize if $self->using_freetds;
122 # create storage for insert/(update blob) transactions,
123 # unless this is that storage
124 return if $self->_is_writer_storage;
126 my $writer_storage = (ref $self)->new;
128 $writer_storage->_is_writer_storage(1);
129 $writer_storage->connect_info($self->connect_info);
130 $writer_storage->auto_cast($self->auto_cast);
132 $self->_writer_storage($writer_storage);
135 for my $method (@also_proxy_to_writer_storage) {
137 no warnings 'redefine';
139 my $replaced = __PACKAGE__->can($method);
141 *{$method} = Sub::Name::subname __PACKAGE__."::$method" => sub {
143 $self->_writer_storage->$replaced(@_) if $self->_writer_storage;
144 return $self->$replaced(@_);
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.
155 $self->next::method(@_);
157 if (not $self->using_freetds) {
158 $self->_dbh->{syb_chained_txn} = 1;
160 if ($self->_dbh_autocommit) {
161 $self->_dbh->do('SET CHAINED OFF');
163 $self->_dbh->do('SET CHAINED ON');
168 =head2 connect_call_blob_setup
172 on_connect_call => [ [ 'blob_setup', log_on_update => 0 ] ]
174 Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
175 instead of as a hex string.
179 Also sets the C<log_on_update> value for blob write operations. The default is
180 C<1>, but C<0> is better if your database is configured for it.
183 L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
187 sub connect_call_blob_setup {
190 my $dbh = $self->_dbh;
191 $dbh->{syb_binary_images} = 1;
193 $self->_blob_log_on_update($args{log_on_update})
194 if exists $args{log_on_update};
200 $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
204 my ($self, $source, $column) = @_;
206 return $self->_is_lob_type($source->column_info($column)->{data_type});
209 sub _prep_for_execute {
211 my ($op, $extra_bind, $ident, $args) = @_;
213 my ($sql, $bind) = $self->next::method (@_);
215 if ($op eq 'insert') {
216 my $table = $ident->from;
218 my $bind_info = $self->_resolve_column_info(
219 $ident, [map $_->[0], @{$bind}]
221 my $identity_col = List::Util::first
222 { $bind_info->{$_}{is_auto_increment} }
228 "SET IDENTITY_INSERT $table ON",
230 "SET IDENTITY_INSERT $table OFF",
234 $identity_col = List::Util::first
235 { $ident->column_info($_)->{is_auto_increment} }
243 $self->_fetch_identity_sql($ident, $identity_col);
247 return ($sql, $bind);
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.
253 our %TYPE_MAPPING = (
256 varchar => 'varchar',
257 varchar2 => 'varchar',
258 timestamp => 'datetime',
260 real => 'double precision',
263 tinyint => 'smallint',
264 float => 'double precision',
266 bigserial => 'numeric',
267 boolean => 'varchar',
271 sub _native_data_type {
272 my ($self, $type) = @_;
275 $type =~ s/\s* identity//x;
277 return uc($TYPE_MAPPING{$type} || $type);
280 sub _fetch_identity_sql {
281 my ($self, $source, $col) = @_;
283 return sprintf ("SELECT MAX(%s) FROM %s",
284 map { $self->sql_maker->_quote ($_) } ($col, $source->from)
292 my ($rv, $sth, @bind) = $self->dbh_do($self->can('_dbh_execute'), @_);
294 if ($op eq 'insert') {
295 $self->_identity($sth->fetchrow_array);
299 return wantarray ? ($rv, $sth, @bind) : $rv;
302 sub last_insert_id { shift->_identity }
304 # handles TEXT/IMAGE and transaction for last_insert_id
307 my ($source, $to_insert) = @_;
309 my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
311 my $identity_col = List::Util::first
312 { $source->column_info($_)->{is_auto_increment} }
315 # do we need the horrific SELECT MAX(COL) hack?
316 my $dumb_last_insert_id =
318 && (not exists $to_insert->{$identity_col})
319 && ($self->_identity_method||'') ne '@@IDENTITY';
321 my $next = $self->next::can;
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)
328 return $self->_insert (
329 $next, $source, $to_insert, $blob_cols, $identity_col
333 # otherwise use the _writer_storage to do the insert+transaction on another
335 my $guard = $self->_writer_storage->txn_scope_guard;
337 my $updated_cols = $self->_writer_storage->_insert (
338 $next, $source, $to_insert, $blob_cols, $identity_col
341 $self->_identity($self->_writer_storage->_identity);
345 return $updated_cols;
349 my ($self, $next, $source, $to_insert, $blob_cols, $identity_col) = @_;
351 my $updated_cols = $self->$next ($source, $to_insert);
354 $identity_col => $self->last_insert_id($source, $identity_col),
359 $self->_insert_blobs ($source, $blob_cols, $final_row) if $blob_cols;
361 return $updated_cols;
366 my ($source, $fields, $where, @rest) = @_;
368 my $wantarray = wantarray;
370 my $blob_cols = $self->_remove_blob_cols($source, $fields);
372 my $table = $source->name;
374 my $identity_col = List::Util::first
375 { $source->column_info($_)->{is_auto_increment} }
378 my $is_identity_update = $identity_col && defined $fields->{$identity_col};
380 if (not $blob_cols) {
381 $self->_set_identity_insert($table, 'update') if $is_identity_update;
382 return $self->next::method(@_);
383 $self->_unset_identity_insert($table, 'update') if $is_identity_update;
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}) {
390 'Update of TEXT/IMAGE column that is also in search condition impossible';
394 # update+blob update(s) done atomically on separate connection
395 $self = $self->_writer_storage;
397 my $guard = $self->txn_scope_guard;
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;
403 $self->next::method($source, \%blobs_to_empty, $where, @rest);
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);
411 $self->_set_identity_insert($table, 'update') if $is_identity_update;
414 @res = $self->next::method(@_);
416 elsif (defined $wantarray) {
417 $res[0] = $self->next::method(@_);
420 $self->next::method(@_);
423 $self->_unset_identity_insert($table, 'update') if $is_identity_update;
428 return $wantarray ? @res : $res[0];
431 ### the insert_bulk stuff stolen from DBI/MSSQL.pm
433 sub _set_identity_insert {
434 my ($self, $table, $op) = @_;
437 'SET IDENTITY_%s %s ON',
438 (uc($op) || 'INSERT'),
439 $self->sql_maker->_quote ($table),
442 $self->_query_start($sql);
444 my $dbh = $self->_get_dbh;
445 eval { $dbh->do ($sql) };
448 $self->_query_end($sql);
451 $self->throw_exception (sprintf "Error executing '%s': %s",
458 sub _unset_identity_insert {
459 my ($self, $table, $op) = @_;
462 'SET IDENTITY_%s %s OFF',
463 (uc($op) || 'INSERT'),
464 $self->sql_maker->_quote ($table),
467 $self->_query_start($sql);
469 my $dbh = $self->_get_dbh;
472 $self->_query_end($sql);
476 sub _can_insert_bulk { 1 }
478 # XXX this should use the DBD::Sybase bulk API, where possible
481 my ($source, $cols, $data) = @_;
483 my $is_identity_insert = (List::Util::first
484 { $source->column_info ($_)->{is_auto_increment} }
490 if ($is_identity_insert) {
491 $self->_set_identity_insert ($source->name);
494 $self->next::method(@_);
496 if ($is_identity_insert) {
497 $self->_unset_identity_insert ($source->name);
501 ### end of stolen insert_bulk section
503 # Make sure blobs are not bound as placeholders, and return any non-empty ones
505 sub _remove_blob_cols {
506 my ($self, $source, $fields) = @_;
510 for my $col (keys %$fields) {
511 if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
512 my $blob_val = delete $fields->{$col};
513 if (not defined $blob_val) {
514 $fields->{$col} = \'NULL';
517 $fields->{$col} = \"''";
518 $blob_cols{$col} = $blob_val unless $blob_val eq '';
523 return keys %blob_cols ? \%blob_cols : undef;
527 my ($self, $source, $blob_cols, $where) = @_;
529 my (@primary_cols) = $source->primary_columns;
531 $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
532 unless @primary_cols;
534 # check if we're updating a single row by PK
535 my $pk_cols_in_where = 0;
536 for my $col (@primary_cols) {
537 $pk_cols_in_where++ if defined $where->{$col};
541 if ($pk_cols_in_where == @primary_cols) {
543 @row_to_update{@primary_cols} = @{$where}{@primary_cols};
544 @rows = \%row_to_update;
546 my $cursor = $self->select ($source, \@primary_cols, $where, {});
548 my %row; @row{@primary_cols} = @$_; \%row
552 for my $row (@rows) {
553 $self->_insert_blobs($source, $blob_cols, $row);
558 my ($self, $source, $blob_cols, $row) = @_;
559 my $dbh = $self->_get_dbh;
561 my $table = $source->name;
564 my (@primary_cols) = $source->primary_columns;
566 $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key')
567 unless @primary_cols;
569 $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values')
570 if ((grep { defined $row{$_} } @primary_cols) != @primary_cols);
572 for my $col (keys %$blob_cols) {
573 my $blob = $blob_cols->{$col};
575 my %where = map { ($_, $row{$_}) } @primary_cols;
577 my $cursor = $self->select ($source, [$col], \%where, {});
579 my $sth = $cursor->sth;
583 $self->throw_exception(
584 "Could not find row in table '$table' for blob update:\n"
585 . $self->_pretty_print (\%where)
591 $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
594 $sth->func('ct_prepare_send') or die $sth->errstr;
596 my $log_on_update = $self->_blob_log_on_update;
597 $log_on_update = 1 if not defined $log_on_update;
599 $sth->func('CS_SET', 1, {
600 total_txtlen => length($blob),
601 log_on_update => $log_on_update
602 }, 'ct_data_info') or die $sth->errstr;
604 $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
606 $sth->func('ct_finish_send') or die $sth->errstr;
609 $sth->finish if $sth;
611 if ($self->using_freetds) {
612 $self->throw_exception (
613 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: '
617 $self->throw_exception($exception);
623 =head2 connect_call_datetime_setup
627 on_connect_call => 'datetime_setup'
629 In L<DBIx::Class::Storage::DBI/connect_info> to set:
631 $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
632 $dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
634 On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
635 L<DateTime::Format::Sybase>, which you will need to install.
637 This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
638 C<SMALLDATETIME> columns only have minute precision.
643 my $old_dbd_warned = 0;
645 sub connect_call_datetime_setup {
647 my $dbh = $self->_dbh;
649 if ($dbh->can('syb_date_fmt')) {
650 # amazingly, this works with FreeTDS
651 $dbh->syb_date_fmt('ISO_strict');
652 } elsif (not $old_dbd_warned) {
653 carp "Your DBD::Sybase is too old to support ".
654 "DBIx::Class::InflateColumn::DateTime, please upgrade!";
658 $dbh->do('SET DATEFORMAT mdy');
664 sub datetime_parser_type { "DateTime::Format::Sybase" }
666 # ->begin_work and such have no effect with FreeTDS but we run them anyway to
667 # let the DBD keep any state it needs to.
669 # If they ever do start working, the extra statements will do no harm (because
670 # Sybase supports nested transactions.)
672 sub _dbh_begin_work {
674 $self->next::method(@_);
675 if ($self->using_freetds) {
676 $self->_get_dbh->do('BEGIN TRAN');
682 if ($self->using_freetds) {
683 $self->_dbh->do('COMMIT');
685 return $self->next::method(@_);
690 if ($self->using_freetds) {
691 $self->_dbh->do('ROLLBACK');
693 return $self->next::method(@_);
696 # savepoint support using ASE syntax
699 my ($self, $name) = @_;
701 $self->_get_dbh->do("SAVE TRANSACTION $name");
704 # A new SAVE TRANSACTION with the same name releases the previous one.
705 sub _svp_release { 1 }
708 my ($self, $name) = @_;
710 $self->_get_dbh->do("ROLLBACK TRANSACTION $name");
715 =head1 Schema::Loader Support
717 There is an experimental branch of L<DBIx::Class::Schema::Loader> that will
718 allow you to dump a schema from most (if not all) versions of Sybase.
720 It is available via subversion from:
722 http://dev.catalyst.perl.org/repos/bast/branches/DBIx-Class-Schema-Loader/current/
726 This driver supports L<DBD::Sybase> compiled against FreeTDS
727 (L<http://www.freetds.org/>) to the best of our ability, however it is
728 recommended that you recompile L<DBD::Sybase> against the Sybase Open Client
729 libraries. They are a part of the Sybase ASE distribution:
731 The Open Client FAQ is here:
732 L<http://www.isug.com/Sybase_FAQ/ASE/section7.html>.
734 Sybase ASE for Linux (which comes with the Open Client libraries) may be
735 downloaded here: L<http://response.sybase.com/forms/ASE_Linux_Download>.
737 To see if you're using FreeTDS check C<< $schema->storage->using_freetds >>, or run:
739 perl -MDBI -le 'my $dbh = DBI->connect($dsn, $user, $pass); print $dbh->{syb_oc_version}'
741 Some versions of the libraries involved will not support placeholders, in which
742 case the storage will be reblessed to
743 L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>.
745 In some configurations, placeholders will work but will throw implicit type
746 conversion errors for anything that's not expecting a string. In such a case,
747 the C<auto_cast> option from L<DBIx::Class::Storage::DBI::AutoCast> is
748 automatically set, which you may enable on connection with
749 L<DBIx::Class::Storage::DBI::AutoCast/connect_call_set_auto_cast>. The type info
750 for the C<CAST>s is taken from the L<DBIx::Class::ResultSource/data_type>
751 definitions in your Result classes, and are mapped to a Sybase type (if it isn't
752 already) using a mapping based on L<SQL::Translator>.
754 In other configurations, placeholers will work just as they do with the Sybase
755 Open Client libraries.
757 Inserts or updates of TEXT/IMAGE columns will B<NOT> work with FreeTDS.
759 =head1 INSERTS WITH PLACEHOLDERS
761 With placeholders enabled, inserts are done in a transaction so that there are
762 no concurrency issues with getting the inserted identity value using
763 C<SELECT MAX(col)>, which is the only way to get the C<IDENTITY> value in this
766 In addition, they are done on a separate connection so that it's possible to
767 have active cursors when doing an insert.
769 When using C<DBIx::Class::Storage::DBI::Sybase::NoBindVars> transactions are
770 disabled, as there are no concurrency issues with C<SELECT @@IDENTITY> as it's a
775 Due to limitations of the TDS protocol, L<DBD::Sybase>, or both; you cannot
776 begin a transaction while there are active cursors. An active cursor is, for
777 example, a L<ResultSet|DBIx::Class::ResultSet> that has been executed using
778 C<next> or C<first> but has not been exhausted or
779 L<reset|DBIx::Class::ResultSet/reset>.
781 For example, this will not work:
783 $schema->txn_do(sub {
784 my $rs = $schema->resultset('Book');
785 while (my $row = $rs->next) {
786 $schema->resultset('MetaData')->create({
793 Transactions done for inserts in C<AutoCommit> mode when placeholders are in use
794 are not affected, as they are done on an extra database handle.
800 =item * use L<DBIx::Class::Storage::DBI::Replicated>
802 =item * L<connect|DBIx::Class::Schema/connect> another L<Schema|DBIx::Class::Schema>
804 =item * load the data from your cursor with L<DBIx::Class::ResultSet/all>
808 =head1 MAXIMUM CONNECTIONS
810 The TDS protocol makes separate connections to the server for active statements
811 in the background. By default the number of such connections is limited to 25,
812 on both the client side and the server side.
814 This is a bit too low for a complex L<DBIx::Class> application, so on connection
815 the client side setting is set to C<256> (see L<DBD::Sybase/maxConnect>.) You
816 can override it to whatever setting you like in the DSN.
819 L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
820 for information on changing the setting on the server side.
824 See L</connect_call_datetime_setup> to setup date formats
825 for L<DBIx::Class::InflateColumn::DateTime>.
827 =head1 TEXT/IMAGE COLUMNS
829 L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
830 C<TEXT/IMAGE> columns.
832 Setting C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use either:
834 $schema->storage->dbh->do("SET TEXTSIZE $bytes");
838 $schema->storage->set_textsize($bytes);
842 However, the C<LongReadLen> you pass in
843 L<DBIx::Class::Storage::DBI/connect_info> is used to execute the equivalent
844 C<SET TEXTSIZE> command on connection.
846 See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
847 setting you need to work with C<IMAGE> columns.
851 See L<DBIx::Class/CONTRIBUTORS>.
855 You may distribute this code under the same terms as Perl itself.