X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase.pm;h=4b1c8d6ae8b05f7e63c0c4475611c57c702f3494;hb=f244a81505f81087d4bd9a435081aa40b5f32435;hp=e96d8fd0a957d963ee9e99b2b93011d7200ff33e;hpb=cd048330042413dacf872868cda3cbad40d083ac;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index e96d8fd..4b1c8d6 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -9,8 +9,9 @@ use base qw/ /; use mro 'c3'; use Carp::Clan qw/^DBIx::Class/; -use List::Util (); -use Sub::Name (); +use List::Util(); +use Sub::Name(); +use Data::Dumper::Concise(); __PACKAGE__->mk_group_accessors('simple' => qw/_identity _blob_log_on_update _writer_storage _is_extra_storage @@ -62,12 +63,13 @@ sub _rebless { my $dbtype = eval { @{$self->_get_dbh->selectrow_arrayref(qq{sp_server_info \@attribute_id=1})}[2] } || ''; + $self->throw_exception("Unable to estable connection to determine database type: $@") + if $@; - my $exception = $@; $dbtype =~ s/\W/_/gi; my $subclass = "DBIx::Class::Storage::DBI::Sybase::${dbtype}"; - if (!$exception && $dbtype && $self->load_optional_class($subclass)) { + if ($dbtype && $self->load_optional_class($subclass)) { bless $self, $subclass; $self->_rebless; } else { # real Sybase @@ -118,9 +120,6 @@ sub _init { my $self = shift; $self->_set_max_connect(256); - # based on LongReadLen in connect_info - $self->set_textsize if $self->using_freetds; - # create storage for insert/(update blob) transactions, # unless this is that storage return if $self->_is_extra_storage; @@ -180,15 +179,17 @@ sub disconnect { $self->next::method; } +# Set up session settings for Sybase databases for the connection. +# # 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 { +# +# Also SET TEXTSIZE for FreeTDS because LongReadLen doesn't work. +sub _run_connection_actions { my $self = shift; - $self->next::method(@_); - if ($self->_is_bulk_storage) { # this should be cleared on every reconnect $self->_began_bulk_work(0); @@ -198,12 +199,17 @@ sub _populate_dbh { if (not $self->using_freetds) { $self->_dbh->{syb_chained_txn} = 1; } else { + # based on LongReadLen in connect_info + $self->set_textsize; + if ($self->_dbh_autocommit) { $self->_dbh->do('SET CHAINED OFF'); } else { $self->_dbh->do('SET CHAINED ON'); } } + + $self->next::method(@_); } =head2 connect_call_blob_setup @@ -253,41 +259,47 @@ sub _prep_for_execute { my ($sql, $bind) = $self->next::method (@_); - if ($op eq 'insert') { - my $table = $ident->from; + my $table = Scalar::Util::blessed($ident) ? $ident->from : $ident; - my $bind_info = $self->_resolve_column_info( - $ident, [map $_->[0], @{$bind}] + my $bind_info = $self->_resolve_column_info( + $ident, [map $_->[0], @{$bind}] + ); + my $bound_identity_col = List::Util::first + { $bind_info->{$_}{is_auto_increment} } + (keys %$bind_info) + ; + my $identity_col = Scalar::Util::blessed($ident) && + List::Util::first + { $ident->column_info($_)->{is_auto_increment} } + $ident->columns + ; + + if (($op eq 'insert' && $bound_identity_col) || + ($op eq 'update' && exists $args->[0]{$identity_col})) { + $sql = join ("\n", + $self->_set_table_identity_sql($op => $table, 'on'), + $sql, + $self->_set_table_identity_sql($op => $table, 'off'), ); - my $identity_col = List::Util::first - { $bind_info->{$_}{is_auto_increment} } - (keys %$bind_info) - ; - - if ($identity_col) { - $sql = join ("\n", - "SET IDENTITY_INSERT $table ON", - $sql, - "SET IDENTITY_INSERT $table OFF", - ); - } - else { - $identity_col = List::Util::first - { $ident->column_info($_)->{is_auto_increment} } - $ident->columns - ; - } + } - if ($identity_col) { - $sql = - "$sql\n" . - $self->_fetch_identity_sql($ident, $identity_col); - } + if ($op eq 'insert' && (not $bound_identity_col) && $identity_col && + (not $self->{insert_bulk})) { + $sql = + "$sql\n" . + $self->_fetch_identity_sql($ident, $identity_col); } return ($sql, $bind); } +sub _set_table_identity_sql { + my ($self, $op, $table, $on_off) = @_; + + return sprintf 'SET IDENTITY_%s %s %s', + uc($op), $self->sql_maker->_quote($table), uc($on_off); +} + # Stolen from SQLT, with some modifications. This is a makeshift # solution before a sane type-mapping library is available, thus # the 'our' for easy overrides. @@ -374,7 +386,7 @@ sub insert { # we are already in a transaction, or there are no blobs # and we don't need the PK - just (try to) do it if ($self->{transaction_depth} - || (!$blob_cols && !$dumb_last_insert_id) + || (!$blob_cols && !$dumb_last_insert_id) ) { return $self->_insert ( $next, $source, $to_insert, $blob_cols, $identity_col @@ -429,18 +441,11 @@ sub update { my $is_identity_update = $identity_col && defined $fields->{$identity_col}; - if (not $blob_cols) { - $self->_set_session_identity(UPDATE => $table, 'ON') - if $is_identity_update; - - return $self->next::method(@_); - - $self->_set_session_identity(UPDATE => $table, 'OFF') - if $is_identity_update; - } + return $self->next::method(@_) unless $blob_cols; # If there are any blobs in $where, Sybase will return a descriptive error # message. +# XXX blobs can still be used with a LIKE query, and this should be handled. # update+blob update(s) done atomically on separate connection $self = $self->_writer_storage; @@ -451,6 +456,8 @@ sub update { # it is originally put by _remove_blob_cols .) my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols; +# We can't only update NULL blobs, because blobs cannot be in the WHERE clause. + $self->next::method($source, \%blobs_to_empty, $where, @rest); # Now update the blobs before the other columns in case the update of other @@ -459,9 +466,6 @@ sub update { my @res; if (%$fields) { - $self->_set_session_identity(UPDATE => $table, 'ON') - if $is_identity_update; - if ($wantarray) { @res = $self->next::method(@_); } @@ -471,9 +475,6 @@ sub update { else { $self->next::method(@_); } - - $self->_set_session_identity(UPDATE => $table, 'OFF') - if $is_identity_update; } $guard->commit; @@ -481,37 +482,6 @@ sub update { return $wantarray ? @res : $res[0]; } -# for IDENTITY_INSERT / IDENTITY_UPDATE -sub _set_session_identity { - my ($self, $op, $table, $off_on) = @_; - - my $sql = sprintf ( - 'SET IDENTITY_%s %s %s', - uc $op, - $self->sql_maker->_quote($table), - uc $off_on, - ); - - $self->_query_start($sql); - - my $dbh = $self->_get_dbh; - eval { - local $dbh->{RaiseError} = 1; - local $dbh->{PrintError} = 0; - $dbh->do ($sql) - }; - my $exception = $@; - - $self->_query_end($sql); - - if ($exception) { - $self->throw_exception (sprintf "Error executing '%s': %s", - $sql, - $exception, - ); - } -} - sub insert_bulk { my $self = shift; my ($source, $cols, $data) = @_; @@ -544,14 +514,14 @@ EOF if (not $use_bulk_api) { my $blob_cols = $self->_remove_blob_cols_array($source, $cols, $data); - ($self, my ($guard)) = do { - if ($self->{transaction_depth} == 0 && $blob_cols) { - ($self->_writer_storage, $self->_writer_storage->txn_scope_guard); - } - else { - ($self, undef); - } - }; +# _execute_array uses a txn anyway, but it ends too early in case we need to +# select max(col) to get the identity for inserting blobs. + ($self, my $guard) = $self->{transaction_depth} == 0 ? + ($self->_writer_storage, $self->_writer_storage->txn_scope_guard) + : + ($self, undef); + + local $self->{insert_bulk} = 1; $self->next::method(@_); @@ -580,6 +550,7 @@ EOF } $guard->commit if $guard; + return; } @@ -664,12 +635,17 @@ EOF }; $self->_execute_array( - $source, $sth, \@bind, \@source_columns, \@new_data, $guard + $source, $sth, \@bind, \@source_columns, \@new_data, sub { + $guard->commit + } ); $bulk->_query_end($sql); }; + my $exception = $@; + DBD::Sybase::set_cslib_cb($orig_cslib_cb); + if ($exception =~ /-Y option/) { carp <<"EOF"; @@ -678,21 +654,26 @@ to regular array inserts: *** Try unsetting the LANG environment variable. -$@ +$exception EOF $self->_bulk_storage(undef); - DBD::Sybase::set_cslib_cb($orig_cslib_cb); unshift @_, $self; goto \&insert_bulk; } elsif ($exception) { - DBD::Sybase::set_cslib_cb($orig_cslib_cb); # rollback makes the bulkLogin connection unusable $self->_bulk_storage->disconnect; $self->throw_exception($exception); } +} - DBD::Sybase::set_cslib_cb($orig_cslib_cb); +sub _dbh_execute_array { + my ($self, $sth, $tuple_status, $cb) = @_; + + my $rv = $self->next::method($sth, $tuple_status); + $cb->() if $cb; + + return $rv; } # Make sure blobs are not bound as placeholders, and return any non-empty ones @@ -715,7 +696,7 @@ sub _remove_blob_cols { } } - return keys %blob_cols ? \%blob_cols : undef; + return %blob_cols ? \%blob_cols : undef; } # same for insert_bulk @@ -804,7 +785,7 @@ sub _insert_blobs { $self->throw_exception( "Could not find row in table '$table' for blob update:\n" - . $self->_pretty_print (\%where) + . Data::Dumper::Concise::Dumper (\%where) ); } @@ -886,7 +867,7 @@ C columns only have minute precision. sub connect_call_datetime_setup { my $self = shift; - my $dbh = $self->_dbh; + my $dbh = $self->_get_dbh; if ($dbh->can('syb_date_fmt')) { # amazingly, this works with FreeTDS @@ -1122,6 +1103,33 @@ loading your app, if it doesn't match the character set of your database. When inserting IMAGE columns using this method, you'll need to use L as well. +=head1 TODO + +=over + +=item * + +Transitions to AutoCommit=0 (starting a transaction) mode by exhausting +any active cursors, using eager cursors. + +=item * + +Real limits and limited counts using stored procedures deployed on startup. + +=item * + +Adaptive Server Anywhere (ASA) support, with possible SQLA::Limit support. + +=item * + +Blob update with a LIKE query on a blob, without invalidating the WHERE condition. + +=item * + +bulk_insert using prepare_cached (see comments.) + +=back + =head1 AUTHOR See L.