1 package DBIx::Class::Storage::DBI::Sybase;
7 DBIx::Class::Storage::DBI::Sybase::Base
8 DBIx::Class::Storage::DBI
11 use Carp::Clan qw/^DBIx::Class/;
15 DBIx::Class::Storage::DBI::Sybase - Storage::DBI subclass for Sybase
19 This subclass supports L<DBD::Sybase> for real Sybase databases. If you are
20 using an MSSQL database via L<DBD::Sybase>, your storage will be reblessed to
21 L<DBIx::Class::Storage::DBI::Sybase::Microsoft_SQL_Server>.
25 If your version of Sybase does not support placeholders, then your storage
26 will be reblessed to L<DBIx::Class::Storage::DBI::Sybase::NoBindVars>. You can
27 also enable that driver explicitly, see the documentation for more details.
29 With this driver there is unfortunately no way to get the C<last_insert_id>
30 without doing a C<select max(col)>.
32 But your queries will be cached.
34 You need a version of L<DBD::Sybase> compiled with the Sybase OpenClient
35 libraries, B<NOT> FreeTDS, for placeholder support. Otherwise your storage will
36 be automatically reblessed into C<::NoBindVars>.
38 A recommended L<DBIx::Class::Storage::DBI/connect_info> settings:
40 on_connect_call => [['datetime_setup'], [blob_setup => log_on_update => 0]]
46 __PACKAGE__->mk_group_accessors('simple' =>
47 qw/_blob_log_on_update/
53 if (ref($self) eq 'DBIx::Class::Storage::DBI::Sybase') {
55 @{$self->dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2]
60 my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}";
62 if (!$exception && $dbtype && $self->load_optional_class($subclass)) {
63 bless $self, $subclass;
65 } else { # real Sybase
66 my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
68 if (not $self->dbh->{syb_dynamic_supported}) {
69 $self->ensure_class_loaded($no_bind_vars);
70 bless $self, $no_bind_vars;
74 if ($self->_using_freetds) {
77 Your version of Sybase potentially supports placeholders and query caching,
78 however you seem to be using FreeTDS which does not (yet?) support this.
80 Please recompile DBD::Sybase with the Sybase OpenClient libraries if you want
83 TEXT/IMAGE column support will also not work under FreeTDS.
85 See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
87 $self->ensure_class_loaded($no_bind_vars);
88 bless $self, $no_bind_vars;
91 $self->_set_maxConnect;
97 my $using_freetds = undef;
101 my $dbh = $self->_dbh;
103 return $using_freetds if defined $using_freetds;
105 # local $dbh->{syb_rowcount} = 1; # this is broken in freetds
106 # $using_freetds = @{ $dbh->selectall_arrayref('sp_help') } != 1;
108 $using_freetds = $dbh->{syb_oc_version} =~ /freetds/i;
110 return $using_freetds;
114 sub _set_maxConnect {
117 my $dsn = $self->_dbi_connect_info->[0];
119 return if ref($dsn) eq 'CODE';
121 if ($dsn !~ /maxConnect=/) {
122 $self->_dbi_connect_info->[0] = "$dsn;maxConnect=256";
123 my $connected = defined $self->_dbh;
125 $self->ensure_connected if $connected;
129 =head2 connect_call_blob_setup
133 on_connect_call => [ [ blob_setup => log_on_update => 0 ] ]
135 Does C<< $dbh->{syb_binary_images} = 1; >> to return C<IMAGE> data as raw binary
136 instead of as a hex string.
140 Also sets the C<log_on_update> value for blob write operations. The default is
141 C<1>, but C<0> is better if your database is configured for it.
144 L<DBD::Sybase/Handling_IMAGE/TEXT_data_with_syb_ct_get_data()/syb_ct_send_data()>.
148 sub connect_call_blob_setup {
151 my $dbh = $self->_dbh;
152 $dbh->{syb_binary_images} = 1;
154 $self->_blob_log_on_update($args{log_on_update})
155 if exists $args{log_on_update};
161 $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
164 ## This will be useful if we ever implement BLOB filehandle inflation and will
165 ## need to use the API, but for now it isn't.
167 #sub order_columns_for_select {
168 # my ($self, $source) = @_;
170 # my (@non_blobs, @blobs);
172 # for my $col ($source->columns) {
173 # if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
176 # push @non_blobs, $col;
180 # croak "cannot select more than a one TEXT/IMAGE column at a time"
183 # return (@non_blobs, @blobs);
186 # override to handle TEXT/IMAGE
188 my ($self, $source, $to_insert) = splice @_, 0, 3;
190 my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
192 my $updated_cols = $self->next::method($source, $to_insert, @_);
194 $self->_insert_blobs($source, $blob_cols, $to_insert) if %$blob_cols;
196 return $updated_cols;
200 my ($self, $source) = splice @_, 0, 2;
201 my ($fields, $where) = @_;
202 my $wantarray = wantarray;
204 my $blob_cols = $self->_remove_blob_cols($source, $fields);
208 @res = $self->next::method($source, @_);
210 $res[0] = $self->next::method($source, @_);
213 $self->_update_blobs($source, $blob_cols, $where) if %$blob_cols;
215 return $wantarray ? @res : $res[0];
218 sub _remove_blob_cols {
219 my ($self, $source, $fields) = @_;
223 for my $col (keys %$fields) {
224 if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
225 $blob_cols{$col} = delete $fields->{$col};
226 $fields->{$col} = \"''";
234 my ($self, $source, $blob_cols, $where) = @_;
236 my (@primary_cols) = $source->primary_columns;
238 croak "Cannot update TEXT/IMAGE column(s) without a primary key"
239 unless @primary_cols;
241 # check if we're updating a single row by PK
242 my $pk_cols_in_where = 0;
243 for my $col (@primary_cols) {
244 $pk_cols_in_where++ if defined $where->{$col};
248 if ($pk_cols_in_where == @primary_cols) {
250 @row_to_update{@primary_cols} = @{$where}{@primary_cols};
251 @rows = \%row_to_update;
253 my $rs = $source->resultset->search(
256 result_class => 'DBIx::Class::ResultClass::HashRefInflator',
257 select => \@primary_cols
260 @rows = $rs->all; # statement must finish
263 for my $row (@rows) {
264 $self->_insert_blobs($source, $blob_cols, $row);
269 my ($self, $source, $blob_cols, $row) = @_;
270 my $dbh = $self->dbh;
272 my $table = $source->from;
275 my (@primary_cols) = $source->primary_columns;
277 croak "Cannot update TEXT/IMAGE column(s) without a primary key"
278 unless @primary_cols;
280 if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) {
281 if (@primary_cols == 1) {
282 my $col = $primary_cols[0];
283 $row{$col} = $self->last_insert_id($source, $col);
285 croak "Cannot update TEXT/IMAGE column(s) without primary key values";
289 for my $col (keys %$blob_cols) {
290 my $blob = $blob_cols->{$col};
293 if (not $self->isa('DBIx::Class::Storage::DBI::NoBindVars')) {
294 my $search_cond = join ',' => map "$_ = ?", @primary_cols;
297 "select $col from $table where $search_cond"
299 $sth->execute(map $row{$_}, @primary_cols);
301 my $search_cond = join ',' => map "$_ = $row{$_}", @primary_cols;
303 $sth = $dbh->prepare(
304 "select $col from $table where $search_cond"
310 while ($sth->fetch) {
311 $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
313 $sth->func('ct_prepare_send') or die $sth->errstr;
315 my $log_on_update = $self->_blob_log_on_update;
316 $log_on_update = 1 if not defined $log_on_update;
318 $sth->func('CS_SET', 1, {
319 total_txtlen => length($blob),
320 log_on_update => $log_on_update
321 }, 'ct_data_info') or die $sth->errstr;
323 $sth->func($blob, length($blob), 'ct_send_data') or die $sth->errstr;
325 $sth->func('ct_finish_send') or die $sth->errstr;
329 croak $exception if $exception;
333 =head2 connect_call_datetime_setup
337 on_connect_call => 'datetime_setup'
339 In L<DBIx::Class::Storage::DBI/connect_info> to set:
341 $dbh->syb_date_fmt('ISO_strict'); # output fmt: 2004-08-21T14:36:48.080Z
342 $dbh->do('set dateformat mdy'); # input fmt: 08/13/1979 18:08:55.080
344 On connection for use with L<DBIx::Class::InflateColumn::DateTime>, using
345 L<DateTime::Format::Sybase>, which you will need to install.
347 This works for both C<DATETIME> and C<SMALLDATETIME> columns, although
348 C<SMALLDATETIME> columns only have minute precision.
353 my $old_dbd_warned = 0;
355 sub connect_call_datetime_setup {
357 my $dbh = $self->_dbh;
359 if ($dbh->can('syb_date_fmt')) {
360 $dbh->syb_date_fmt('ISO_strict');
361 } elsif (not $old_dbd_warned) {
362 carp "Your DBD::Sybase is too old to support ".
363 "DBIx::Class::InflateColumn::DateTime, please upgrade!";
367 $dbh->do('set dateformat mdy');
373 sub datetime_parser_type { "DateTime::Format::Sybase" }
375 sub _dbh_last_insert_id {
376 my ($self, $dbh, $source, $col) = @_;
378 # sorry, there's no other way!
379 my $sth = $self->sth("select max($col) from ".$source->from);
380 my ($id) = $dbh->selectrow_array($sth);
388 =head1 MAXIMUM CONNECTIONS
390 L<DBD::Sybase> makes separate connections to the server for active statements in
391 the background. By default the number of such connections is limited to 25, on
392 both the client side and the server side.
394 This is a bit too low, so on connection the clientside setting is set to C<256>
395 (see L<DBD::Sybase/maxConnect>.) You can override it to whatever setting you
399 L<http://infocenter.sybase.com/help/index.jsp?topic=/com.sybase.help.ase_15.0.sag1/html/sag1/sag1272.htm>
400 for information on changing the setting on the server side.
404 See L</connect_call_datetime_setup> to setup date formats
405 for L<DBIx::Class::InflateColumn::DateTime>.
407 =head1 IMAGE AND TEXT COLUMNS
409 L<DBD::Sybase> compiled with FreeTDS will B<NOT> work with C<TEXT/IMAGE>
412 See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
413 setting you need to work with C<IMAGE> columns.
417 See L<DBIx::Class/CONTRIBUTORS>.
421 You may distribute this code under the same terms as Perl itself.