From: Rafael Kitover Date: Mon, 27 Jul 2009 01:48:35 +0000 (+0000) Subject: better FreeTDS support X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a3a526ccbf65e59361a29b753f4bdd9495ad6dd5;p=dbsrgits%2FDBIx-Class-Historic.git better FreeTDS support --- diff --git a/lib/DBIx/Class/Storage/DBI.pm b/lib/DBIx/Class/Storage/DBI.pm index 1a42609..12dfe83 100644 --- a/lib/DBIx/Class/Storage/DBI.pm +++ b/lib/DBIx/Class/Storage/DBI.pm @@ -629,7 +629,8 @@ sub disconnect { $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 @@ sub txn_begin { # 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 txn_commit { } } +sub _dbh_commit { + my $self = shift; + $self->_dbh->commit; +} + sub txn_rollback { my $self = shift; my $dbh = $self->_dbh; @@ -1019,7 +1030,7 @@ sub txn_rollback { 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 txn_rollback { } } +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. diff --git a/lib/DBIx/Class/Storage/DBI/Cursor.pm b/lib/DBIx/Class/Storage/DBI/Cursor.pm index 3d59e84..be45ce5 100644 --- a/lib/DBIx/Class/Storage/DBI/Cursor.pm +++ b/lib/DBIx/Class/Storage/DBI/Cursor.pm @@ -3,7 +3,14 @@ package DBIx::Class::Storage::DBI::Cursor; 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 @@ -73,24 +80,24 @@ sub _dbh_next { && $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 @@ sub _dbh_all { 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 @@ sub reset { 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 @@ sub DESTROY { # 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; diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 659aad6..555f0d5 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -12,7 +12,7 @@ use Carp::Clan qw/^DBIx::Class/; 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 @@ sub _rebless { } 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}; + +You are using FreeTDS with Sybase. -Your version of Sybase potentially supports placeholders and query caching, -however you seem to be using FreeTDS which does not (yet?) support this. +We will do our best to support this configuration, but please consider this +support experimental. -Please recompile DBD::Sybase with the Sybase OpenClient libraries if you want -these features. +TEXT/IMAGE columns will definitely not work. -TEXT/IMAGE column support will also not work under FreeTDS. +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 @@ EOF $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'; + $self->next::method(@_); - 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 @@ sub _is_lob_type { $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 @@ List::Util::first { $bind_info->{$_}{is_auto_increment} } (keys %$bind_info); 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 _execute { 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 @@ sub _insert_blobs { my $blob = $blob_cols->{$col}; my $sth; - if (not $self->isa('DBIx::Class::Storage::DBI::NoBindVars')) { - my $search_cond = join ',' => map "$_ = ?", @primary_cols; - - $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; - } + my %where = map { ($_, $row{$_}) } @primary_cols; + my $cursor = $source->resultset->search(\%where, { + select => [$col] + })->cursor; + $cursor->next; + $sth = $cursor->sth; 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 @@ sub _insert_blobs { $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 @@ C columns only have minute precision. 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,8 +548,14 @@ for L. =head1 IMAGE AND TEXT COLUMNS -L compiled with FreeTDS will B work with C -columns. +L compiled with FreeTDS will B allow you to insert or update +C columns. + +C<< $dbh->{LongReadLen} >> will also not work with FreeTDS use: + + $schema->storage->dbh->do("SET TEXTSIZE ") + +instead. See L for a L setting you need to work with C columns. diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm index af2a98f..1faec6c 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/Base.pm @@ -35,11 +35,43 @@ sub _placeholders_supported { # 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 diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm index 0ca20a4..4d05295 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm @@ -11,6 +11,7 @@ use Scalar::Util (); sub _rebless { my $self = shift; $self->disable_sth_caching(1); + $self->_insert_txn(0); } # this works when NOT using placeholders diff --git a/t/746sybase.t b/t/746sybase.t index e94da41..f09f16a 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -160,9 +160,12 @@ SQL $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;