[Bast-commits] r7125 - in DBIx-Class/0.08/branches/sybase:
lib/DBIx/Class/Storage lib/DBIx/Class/Storage/DBI
lib/DBIx/Class/Storage/DBI/Sybase t
caelum at dev.catalyst.perl.org
caelum at dev.catalyst.perl.org
Mon Jul 27 01:48:37 GMT 2009
Author: caelum
Date: 2009-07-27 01:48:35 +0000 (Mon, 27 Jul 2009)
New Revision: 7125
Modified:
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Cursor.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
DBIx-Class/0.08/branches/sybase/t/746sybase.t
Log:
better FreeTDS support
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Cursor.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Cursor.pm 2009-07-27 01:48:35 UTC (rev 7125)
@@ -3,8 +3,15 @@
use strict;
use warnings;
-use base qw/DBIx::Class::Cursor/;
+use base qw/
+ Class::Accessor::Grouped
+ DBIx::Class::Cursor
+/;
+__PACKAGE__->mk_group_accessors('simple' =>
+ qw/sth/
+);
+
=head1 NAME
DBIx::Class::Storage::DBI::Cursor - Object representing a query cursor on a
@@ -73,24 +80,24 @@
&& $self->{attrs}{rows}
&& $self->{pos} >= $self->{attrs}{rows}
) {
- $self->{sth}->finish if $self->{sth}->{Active};
- delete $self->{sth};
+ $self->sth->finish if $self->sth->{Active};
+ $self->sth(undef);
$self->{done} = 1;
}
return if $self->{done};
- unless ($self->{sth}) {
- $self->{sth} = ($storage->_select(@{$self->{args}}))[1];
+ unless ($self->sth) {
+ $self->sth(($storage->_select(@{$self->{args}}))[1]);
if ($self->{attrs}{software_limit}) {
if (my $offset = $self->{attrs}{offset}) {
- $self->{sth}->fetch for 1 .. $offset;
+ $self->sth->fetch for 1 .. $offset;
}
}
}
- my @row = $self->{sth}->fetchrow_array;
+ my @row = $self->sth->fetchrow_array;
if (@row) {
$self->{pos}++;
} else {
- delete $self->{sth};
+ $self->sth(undef);
$self->{done} = 1;
}
return @row;
@@ -120,8 +127,8 @@
my ($storage, $dbh, $self) = @_;
$self->_check_dbh_gen;
- $self->{sth}->finish if $self->{sth}->{Active};
- delete $self->{sth};
+ $self->sth->finish if $self->sth->{Active};
+ $self->sth(undef);
my ($rv, $sth) = $storage->_select(@{$self->{args}});
return @{$sth->fetchall_arrayref};
}
@@ -146,14 +153,14 @@
my ($self) = @_;
# No need to care about failures here
- eval { $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active} };
+ eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
$self->_soft_reset;
}
sub _soft_reset {
my ($self) = @_;
- delete $self->{sth};
+ $self->sth(undef);
delete $self->{done};
$self->{pos} = 0;
return $self;
@@ -173,7 +180,7 @@
# None of the reasons this would die matter if we're in DESTROY anyways
local $@;
- eval { $self->{sth}->finish if $self->{sth} && $self->{sth}->{Active} };
+ eval { $self->sth->finish if $self->sth && $self->sth->{Active} };
}
1;
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm 2009-07-27 01:48:35 UTC (rev 7125)
@@ -35,11 +35,43 @@
# There's also $dbh->{syb_dynamic_supported} but it can be inaccurate for this
# purpose.
local $dbh->{PrintError} = 0;
+ $dbh->selectrow_array('select ?', {}, 1);
+ };
+}
+
+sub _placeholders_with_type_conversion_supported {
+ my $self = shift;
+ my $dbh = $self->_dbh;
+
+ return eval {
+ local $dbh->{PrintError} = 0;
# this specifically tests a bind that is NOT a string
$dbh->selectrow_array('select 1 where 1 = ?', {}, 1);
};
}
+sub _set_max_connect {
+ my $self = shift;
+ my $val = shift || 256;
+
+ my $dsn = $self->_dbi_connect_info->[0];
+
+ return if ref($dsn) eq 'CODE';
+
+ if ($dsn !~ /maxConnect=/) {
+ $self->_dbi_connect_info->[0] = "$dsn;maxConnect=$val";
+ my $connected = defined $self->_dbh;
+ $self->disconnect;
+ $self->ensure_connected if $connected;
+ }
+}
+
+sub _using_freetds {
+ my $self = shift;
+
+ return $self->_dbh->{syb_oc_version} =~ /freetds/i;
+}
+
1;
=head1 AUTHORS
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm 2009-07-27 01:48:35 UTC (rev 7125)
@@ -11,6 +11,7 @@
sub _rebless {
my $self = shift;
$self->disable_sth_caching(1);
+ $self->_insert_txn(0);
}
# this works when NOT using placeholders
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI/Sybase.pm 2009-07-27 01:48:35 UTC (rev 7125)
@@ -12,7 +12,7 @@
use List::Util ();
__PACKAGE__->mk_group_accessors('simple' =>
- qw/_identity _blob_log_on_update/
+ qw/_identity _blob_log_on_update _auto_cast _insert_txn/
);
=head1 NAME
@@ -66,22 +66,37 @@
} else { # real Sybase
my $no_bind_vars = 'DBIx::Class::Storage::DBI::Sybase::NoBindVars';
+# This is reset to 0 in ::NoBindVars, only necessary because we use max(col) to
+# get the identity.
+ $self->_insert_txn(1);
+
if ($self->_using_freetds) {
- carp <<'EOF';
+ carp <<'EOF' unless $ENV{DBIC_SYBASE_FREETDS_NOWARN};
-Your version of Sybase potentially supports placeholders and query caching,
-however you seem to be using FreeTDS which does not (yet?) support this.
+You are using FreeTDS with Sybase.
-Please recompile DBD::Sybase with the Sybase OpenClient libraries if you want
-these features.
+We will do our best to support this configuration, but please consider this
+support experimental.
-TEXT/IMAGE column support will also not work under FreeTDS.
+TEXT/IMAGE columns will definitely not work.
+You are encouraged to recompile DBD::Sybase with the Sybase OpenClient libraries
+instead.
+
See perldoc DBIx::Class::Storage::DBI::Sybase for more details.
+
+To turn off this warning set the DBIC_SYBASE_FREETDS_NOWARN environment
+variable.
EOF
- $self->ensure_class_loaded($no_bind_vars);
- bless $self, $no_bind_vars;
- $self->_rebless;
+ if (not $self->_placeholders_with_type_conversion_supported) {
+ if ($self->_placeholders_supported) {
+ $self->_auto_cast(1);
+ } else {
+ $self->ensure_class_loaded($no_bind_vars);
+ bless $self, $no_bind_vars;
+ $self->_rebless;
+ }
+ }
}
if (not $self->dbh->{syb_dynamic_supported}) {
@@ -90,37 +105,28 @@
$self->_rebless;
}
- $self->_set_maxConnect;
+ $self->_set_max_connect(256);
}
}
}
-# Make sure we have CHAINED mode turned on, we don't know how DBD::Sybase was
-# compiled.
+# Make sure we have CHAINED mode turned on if AutoCommit is off in non-FreeTDS
+# DBD::Sybase (since we don't know how DBD::Sybase was compiled.) If however
+# we're using FreeTDS, CHAINED mode turns on an implicit transaction which we
+# only want when AutoCommit is off.
sub _populate_dbh {
my $self = shift;
+
$self->next::method(@_);
- $self->_dbh->{syb_chained_txn} = 1;
-}
-sub _using_freetds {
- my $self = shift;
-
- return $self->_dbh->{syb_oc_version} =~ /freetds/i;
-}
-
-sub _set_maxConnect {
- my $self = shift;
-
- my $dsn = $self->_dbi_connect_info->[0];
-
- return if ref($dsn) eq 'CODE';
-
- if ($dsn !~ /maxConnect=/) {
- $self->_dbi_connect_info->[0] = "$dsn;maxConnect=256";
- my $connected = defined $self->_dbh;
- $self->disconnect;
- $self->ensure_connected if $connected;
+ if (not $self->_using_freetds) {
+ $self->_dbh->{syb_chained_txn} = 1;
+ } else {
+ if ($self->_dbh_autocommit) {
+ $self->_dbh->do('SET CHAINED OFF');
+ } else {
+ $self->_dbh->do('SET CHAINED ON');
+ }
}
}
@@ -159,39 +165,43 @@
$type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i;
}
-## This will be useful if we ever implement BLOB filehandle inflation and will
-## need to use the API, but for now it isn't.
-#
-#sub order_columns_for_select {
-# my ($self, $source, $columns) = @_;
-#
-# my (@non_blobs, @blobs);
-#
-# for my $col (@$columns) {
-# if ($self->_is_lob_type($source->column_info($col)->{data_type})) {
-# push @blobs, $col;
-# } else {
-# push @non_blobs, $col;
-# }
-# }
-#
-# croak "cannot select more than a one TEXT/IMAGE column at a time"
-# if @blobs > 1;
-#
-# return (@non_blobs, @blobs);
-#}
-
-# the select-piggybacking-on-insert trick stolen from odbc/mssql
+# The select-piggybacking-on-insert trick stolen from odbc/mssql
sub _prep_for_execute {
my $self = shift;
my ($op, $extra_bind, $ident, $args) = @_;
my ($sql, $bind) = $self->next::method (@_);
+# Some combinations of FreeTDS and Sybase throw implicit conversion errors for
+# all placeeholders, so we convert them into CASTs here.
+# Based on code in ::DBI::NoBindVars .
+#
+# If we're using ::NoBindVars, there are no binds by this point so this code
+# gets skippeed.
+ if ($self->_auto_cast && @$bind) {
+ my $new_sql;
+ my @sql_part = split /\?/, $sql;
+ my $col_info = $self->_resolve_column_info($ident,[ map $_->[0], @$bind ]);
+
+ foreach my $bound (@$bind) {
+ my $col = $bound->[0];
+ my $syb_type = $self->_syb_base_type($col_info->{$col}{data_type});
+
+ foreach my $data (@{$bound}[1..$#$bound]) {
+ $new_sql .= shift(@sql_part) .
+ ($syb_type ? "CAST(? AS $syb_type)" : '?');
+ }
+ }
+ $new_sql .= join '', @sql_part;
+ $sql = $new_sql;
+ }
+
if ($op eq 'insert') {
my $table = $ident->from;
- my $bind_info = $self->_resolve_column_info($ident, [map $_->[0], @{$bind}]);
+ my $bind_info = $self->_resolve_column_info(
+ $ident, [map $_->[0], @{$bind}]
+ );
my $identity_col =
List::Util::first { $bind_info->{$_}{is_auto_increment} } (keys %$bind_info);
@@ -209,13 +219,42 @@
if ($identity_col) {
$sql =
"$sql\n" .
- $self->_fetch_identity_sql($ident, $identity_col) . "\n";
+ $self->_fetch_identity_sql($ident, $identity_col);
}
}
return ($sql, $bind);
}
+# Stolen from SQLT, with some modifications. This will likely change when the
+# SQLT Sybase stuff is redone/fixed-up.
+my %TYPE_MAPPING = (
+ number => 'numeric',
+ money => 'money',
+ varchar => 'varchar',
+ varchar2 => 'varchar',
+ timestamp => 'datetime',
+ text => 'varchar',
+ real => 'double precision',
+ comment => 'text',
+ bit => 'bit',
+ tinyint => 'smallint',
+ float => 'double precision',
+ serial => 'numeric',
+ bigserial => 'numeric',
+ boolean => 'varchar',
+ long => 'varchar',
+);
+
+sub _syb_base_type {
+ my ($self, $type) = @_;
+
+ $type = lc $type;
+ $type =~ s/ identity//;
+
+ return uc($TYPE_MAPPING{$type} || $type);
+}
+
sub _fetch_identity_sql {
my ($self, $source, $col) = @_;
@@ -238,23 +277,25 @@
sub last_insert_id { shift->_identity }
-# override to handle TEXT/IMAGE and nested txn
+# override to handle TEXT/IMAGE and to do a transaction if necessary
sub insert {
my ($self, $source, $to_insert) = splice @_, 0, 3;
my $dbh = $self->_dbh;
my $blob_cols = $self->_remove_blob_cols($source, $to_insert);
-# Sybase has savepoints fortunately, because we have to do the insert in a
-# transaction to avoid race conditions with the SELECT MAX(COL) identity method
-# used when placeholders are enabled.
+# We have to do the insert in a transaction to avoid race conditions with the
+# SELECT MAX(COL) identity method used when placeholders are enabled.
my $updated_cols = do {
- local $self->{auto_savepoint} = 1;
- my $args = \@_;
- my $method = $self->next::can;
- $self->txn_do(
- sub { $self->$method($source, $to_insert, @$args) }
- );
+ if ($self->_insert_txn && (not $self->{transaction_depth})) {
+ my $args = \@_;
+ my $method = $self->next::can;
+ $self->txn_do(
+ sub { $self->$method($source, $to_insert, @$args) }
+ );
+ } else {
+ $self->next::method($source, $to_insert, @_);
+ }
};
$self->_insert_blobs($source, $blob_cols, $to_insert) if %$blob_cols;
@@ -356,26 +397,18 @@
my $blob = $blob_cols->{$col};
my $sth;
- if (not $self->isa('DBIx::Class::Storage::DBI::NoBindVars')) {
- my $search_cond = join ',' => map "$_ = ?", @primary_cols;
+ my %where = map { ($_, $row{$_}) } @primary_cols;
+ my $cursor = $source->resultset->search(\%where, {
+ select => [$col]
+ })->cursor;
+ $cursor->next;
+ $sth = $cursor->sth;
- $sth = $self->sth(
- "select $col from $table where $search_cond"
- );
- $sth->execute(map $row{$_}, @primary_cols);
- } else {
- my $search_cond = join ',' => map "$_ = $row{$_}", @primary_cols;
-
- $sth = $dbh->prepare(
- "select $col from $table where $search_cond"
- );
- $sth->execute;
- }
-
eval {
- while ($sth->fetch) {
+ do {
$sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr;
- }
+ } while $sth->fetch;
+
$sth->func('ct_prepare_send') or die $sth->errstr;
my $log_on_update = $self->_blob_log_on_update;
@@ -391,8 +424,16 @@
$sth->func('ct_finish_send') or die $sth->errstr;
};
my $exception = $@;
- $sth->finish;
- croak $exception if $exception;
+ $sth->finish if $sth;
+ if ($exception) {
+ if ($self->_using_freetds) {
+ croak
+"TEXT/IMAGE operation failed, probably because you're using FreeTDS: " .
+$exception;
+ } else {
+ croak $exception;
+ }
+ }
}
}
@@ -438,6 +479,35 @@
sub datetime_parser_type { "DateTime::Format::Sybase" }
+# ->begin_work and such have no effect with FreeTDS
+
+sub _dbh_begin_work {
+ my $self = shift;
+ if (not $self->_using_freetds) {
+ return $self->next::method(@_);
+ } else {
+ $self->dbh->do('BEGIN TRAN');
+ }
+}
+
+sub _dbh_commit {
+ my $self = shift;
+ if (not $self->_using_freetds) {
+ return $self->next::method(@_);
+ } else {
+ $self->_dbh->do('COMMIT');
+ }
+}
+
+sub _dbh_rollback {
+ my $self = shift;
+ if (not $self->_using_freetds) {
+ return $self->next::method(@_);
+ } else {
+ $self->_dbh->do('ROLLBACK');
+ }
+}
+
# savepoint support using ASE syntax
sub _svp_begin {
@@ -478,9 +548,15 @@
=head1 IMAGE AND TEXT COLUMNS
-L<DBD::Sybase> compiled with FreeTDS will B<NOT> work with C<TEXT/IMAGE>
-columns.
+L<DBD::Sybase> compiled with FreeTDS will B<NOT> allow you to insert or update
+C<TEXT/IMAGE> columns.
+C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use:
+
+ $schema->storage->dbh->do("SET TEXTSIZE <bytes>")
+
+instead.
+
See L</connect_call_blob_setup> for a L<DBIx::Class::Storage::DBI/connect_info>
setting you need to work with C<IMAGE> columns.
Modified: DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm
===================================================================
--- DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/lib/DBIx/Class/Storage/DBI.pm 2009-07-27 01:48:35 UTC (rev 7125)
@@ -629,7 +629,8 @@
$self->_do_connection_actions(disconnect_call_ => $_) for @actions;
- $self->_dbh->rollback unless $self->_dbh_autocommit;
+ $self->_dbh_rollback unless $self->_dbh_autocommit;
+
$self->_dbh->disconnect;
$self->_dbh(undef);
$self->{_dbh_gen}++;
@@ -986,20 +987,25 @@
# this isn't ->_dbh-> because
# we should reconnect on begin_work
# for AutoCommit users
- $self->dbh->begin_work;
+ $self->_dbh_begin_work;
} elsif ($self->auto_savepoint) {
$self->svp_begin;
}
$self->{transaction_depth}++;
}
+sub _dbh_begin_work {
+ my $self = shift;
+ $self->dbh->begin_work;
+}
+
sub txn_commit {
my $self = shift;
if ($self->{transaction_depth} == 1) {
my $dbh = $self->_dbh;
$self->debugobj->txn_commit()
if ($self->debug);
- $dbh->commit;
+ $self->_dbh_commit;
$self->{transaction_depth} = 0
if $self->_dbh_autocommit;
}
@@ -1010,6 +1016,11 @@
}
}
+sub _dbh_commit {
+ my $self = shift;
+ $self->_dbh->commit;
+}
+
sub txn_rollback {
my $self = shift;
my $dbh = $self->_dbh;
@@ -1019,7 +1030,7 @@
if ($self->debug);
$self->{transaction_depth} = 0
if $self->_dbh_autocommit;
- $dbh->rollback;
+ $self->_dbh_rollback;
}
elsif($self->{transaction_depth} > 1) {
$self->{transaction_depth}--;
@@ -1042,6 +1053,11 @@
}
}
+sub _dbh_rollback {
+ my $self = shift;
+ $self->_dbh->rollback;
+}
+
# This used to be the top-half of _execute. It was split out to make it
# easier to override in NoBindVars without duping the rest. It takes up
# all of _execute's args, and emits $sql, @bind.
Modified: DBIx-Class/0.08/branches/sybase/t/746sybase.t
===================================================================
--- DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-26 16:04:29 UTC (rev 7124)
+++ DBIx-Class/0.08/branches/sybase/t/746sybase.t 2009-07-27 01:48:35 UTC (rev 7125)
@@ -160,9 +160,12 @@
$binstr{'large'} = $binstr{'small'} x 1024;
my $maxloblen = length $binstr{'large'};
- note
- "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
- local $dbh->{'LongReadLen'} = $maxloblen * 2;
+
+ if (not $schema->storage->_using_freetds) {
+ $dbh->{'LongReadLen'} = $maxloblen * 2;
+ } else {
+ $dbh->do("set textsize ".($maxloblen * 2));
+ }
my $rs = $schema->resultset('BindType');
my $last_id;
More information about the Bast-commits
mailing list