X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase.pm;h=9851303d6a384d024080e48651600a51e7700fad;hb=689819e14e9e6245000c64ece46ddd1bc8293bf5;hp=b3f8c4be6e6ca5a6725f25340ba589edd1308a70;hpb=2563aa9b940f39a063bd696494623aaacbcf3cd2;p=dbsrgits%2FDBIx-Class.git diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index b3f8c4b..9851303 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -13,13 +13,14 @@ use List::Util (); use Sub::Name (); __PACKAGE__->mk_group_accessors('simple' => - qw/_identity _blob_log_on_update _writer_storage _is_extra_storage - _bulk_storage _is_bulk_storage _began_bulk_work - _bulk_disabled_due_to_coderef_connect_info_warned + qw/_identity _blob_log_on_update _writer_storage _is_writer_storage _identity_method/ ); -my @also_proxy_to_extra_storages = qw/ +my @also_proxy_to_writer_storage = qw/ + connect_call_set_auto_cast auto_cast connect_call_blob_setup + connect_call_datetime_setup + disconnect _connect_info _sql_maker _sql_maker_opts disable_sth_caching auto_savepoint unsafe cursor_class debug debugobj schema /; @@ -104,7 +105,7 @@ EOF bless $self, $no_bind_vars; $self->_rebless; } elsif (not $self->_typeless_placeholders_supported) { - # this is highly unlikely, but we check just in case +# this is highly unlikely, but we check just in case $self->auto_cast(1); } } @@ -120,62 +121,30 @@ sub _init { # create storage for insert/(update blob) transactions, # unless this is that storage - return if $self->_is_extra_storage; + return if $self->_is_writer_storage; my $writer_storage = (ref $self)->new; - $writer_storage->_is_extra_storage(1); + $writer_storage->_is_writer_storage(1); $writer_storage->connect_info($self->connect_info); + $writer_storage->auto_cast($self->auto_cast); $self->_writer_storage($writer_storage); - -# create a bulk storage unless connect_info is a coderef - return - if (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE'; - - my $bulk_storage = (ref $self)->new; - - $bulk_storage->_is_extra_storage(1); - $bulk_storage->_is_bulk_storage(1); # for special ->disconnect acrobatics - $bulk_storage->connect_info($self->connect_info); - -# this is why - $bulk_storage->_dbi_connect_info->[0] .= ';bulkLogin=1'; - - $self->_bulk_storage($bulk_storage); } -for my $method (@also_proxy_to_extra_storages) { +for my $method (@also_proxy_to_writer_storage) { no strict 'refs'; no warnings 'redefine'; my $replaced = __PACKAGE__->can($method); - *{$method} = Sub::Name::subname $method => sub { + *{$method} = Sub::Name::subname __PACKAGE__."::$method" => sub { my $self = shift; $self->_writer_storage->$replaced(@_) if $self->_writer_storage; - $self->_bulk_storage->$replaced(@_) if $self->_bulk_storage; return $self->$replaced(@_); }; } -sub disconnect { - my $self = shift; - -# Even though we call $sth->finish for uses off the bulk API, there's still an -# "active statement" warning on disconnect, which we throw away here. -# This is due to the bug described in insert_bulk. -# Currently a noop because 'prepare' is used instead of 'prepare_cached'. - local $SIG{__WARN__} = sub { - warn $_[0] unless $_[0] =~ /active statement/i; - } if $self->_is_bulk_storage; - -# so that next transaction gets a dbh - $self->_began_bulk_work(0) if $self->_is_bulk_storage; - - $self->next::method; -} - # 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 @@ -184,12 +153,6 @@ sub _populate_dbh { my $self = shift; $self->next::method(@_); - - if ($self->_is_bulk_storage) { -# this should be cleared on every reconnect - $self->_began_bulk_work(0); - return; - } if (not $self->using_freetds) { $self->_dbh->{syb_chained_txn} = 1; @@ -237,6 +200,12 @@ sub _is_lob_type { $type && $type =~ /(?:text|image|lob|bytea|binary|memo)/i; } +sub _is_lob_column { + my ($self, $source, $column) = @_; + + return $self->_is_lob_type($source->column_info($column)->{data_type}); +} + sub _prep_for_execute { my $self = shift; my ($op, $extra_bind, $ident, $args) = @_; @@ -394,13 +363,32 @@ sub _insert { sub update { my $self = shift; - my ($source, $fields, $where) = @_; + my ($source, $fields, $where, @rest) = @_; my $wantarray = wantarray; + my $blob_cols = $self->_remove_blob_cols($source, $fields); + my $table = $source->name; + + my $identity_col = List::Util::first + { $source->column_info($_)->{is_auto_increment} } + $source->columns; + + my $is_identity_update = $identity_col && defined $fields->{$identity_col}; + if (not $blob_cols) { + $self->_set_identity_insert($table, 'update') if $is_identity_update; return $self->next::method(@_); + $self->_unset_identity_insert($table, 'update') if $is_identity_update; + } + +# check that we're not updating a blob column that's also in $where + for my $blob (grep $self->_is_lob_column($source, $_), $source->columns) { + if (exists $where->{$blob} && exists $fields->{$blob}) { + croak +'Update of TEXT/IMAGE column that is also in search condition impossible'; + } } # update+blob update(s) done atomically on separate connection @@ -408,37 +396,58 @@ sub update { my $guard = $self->txn_scope_guard; - my @res; - if ($wantarray) { - @res = $self->next::method(@_); - } - elsif (defined $wantarray) { - $res[0] = $self->next::method(@_); - } - else { - $self->next::method(@_); - } +# First update the blob columns to be updated to '' (taken from $fields, where +# it is originally put by _remove_blob_cols .) + my %blobs_to_empty = map { ($_ => delete $fields->{$_}) } keys %$blob_cols; + + $self->next::method($source, \%blobs_to_empty, $where, @rest); +# Now update the blobs before the other columns in case the update of other +# columns makes the search condition invalid. $self->_update_blobs($source, $blob_cols, $where); + my @res; + if (%$fields) { + $self->_set_identity_insert($table, 'update') if $is_identity_update; + + if ($wantarray) { + @res = $self->next::method(@_); + } + elsif (defined $wantarray) { + $res[0] = $self->next::method(@_); + } + else { + $self->next::method(@_); + } + + $self->_unset_identity_insert($table, 'update') if $is_identity_update; + } + $guard->commit; return $wantarray ? @res : $res[0]; } -### the insert_bulk partially stolen from DBI/MSSQL.pm +### the insert_bulk stuff stolen from DBI/MSSQL.pm sub _set_identity_insert { - my ($self, $table) = @_; + my ($self, $table, $op) = @_; my $sql = sprintf ( - 'SET IDENTITY_INSERT %s ON', + 'SET IDENTITY_%s %s ON', + (uc($op) || 'INSERT'), $self->sql_maker->_quote ($table), ); + $self->_query_start($sql); + my $dbh = $self->_get_dbh; eval { $dbh->do ($sql) }; - if ($@) { + my $exception = $@; + + $self->_query_end($sql); + + if ($exception) { $self->throw_exception (sprintf "Error executing '%s': %s", $sql, $dbh->errstr, @@ -447,172 +456,52 @@ sub _set_identity_insert { } sub _unset_identity_insert { - my ($self, $table) = @_; + my ($self, $table, $op) = @_; my $sql = sprintf ( - 'SET IDENTITY_INSERT %s OFF', + 'SET IDENTITY_%s %s OFF', + (uc($op) || 'INSERT'), $self->sql_maker->_quote ($table), ); + $self->_query_start($sql); + my $dbh = $self->_get_dbh; $dbh->do ($sql); + + $self->_query_end($sql); } -## XXX add blob support +# for tests +sub _can_insert_bulk { 1 } + +# XXX this should use the DBD::Sybase bulk API, where possible sub insert_bulk { my $self = shift; my ($source, $cols, $data) = @_; my $is_identity_insert = (List::Util::first - { $source->column_info ($_)->{is_auto_increment} } @{$cols} - ) ? 1 : 0; - - my @source_columns = $source->columns; - - my $use_bulk_api = - $self->_bulk_storage && - $self->_get_dbh->{syb_has_blk}; - - if ((not $use_bulk_api) && - (Scalar::Util::reftype($self->_dbi_connect_info->[0])||'') eq 'CODE' && - (not $self->_bulk_disabled_due_to_coderef_connect_info_warned)) { - carp <<'EOF'; -Bulk API support disabled due to use of a CODEREF connect_info. Reverting to -array inserts. -EOF - $self->_bulk_disabled_due_to_coderef_connect_info_warned(1); + { $source->column_info ($_)->{is_auto_increment} } + (@{$cols}) + ) + ? 1 + : 0; + + if ($is_identity_insert) { + $self->_set_identity_insert ($source->name); } - if (not $use_bulk_api) { - if ($is_identity_insert) { - $self->_set_identity_insert ($source->name); - } - - $self->next::method(@_); - - if ($is_identity_insert) { - $self->_unset_identity_insert ($source->name); - } - - return; - } - -# otherwise, use the bulk API - -# rearrange @$data so that columns are in database order - my %orig_idx; - @orig_idx{@$cols} = 0..$#$cols; - - my %new_idx; - @new_idx{@source_columns} = 0..$#source_columns; - - my @new_data; - for my $datum (@$data) { - my $new_datum = []; - for my $col (@source_columns) { -# identity data will be 'undef' if not $is_identity_insert -# columns with defaults will also be 'undef' - $new_datum->[ $new_idx{$col} ] = - exists $orig_idx{$col} ? $datum->[ $orig_idx{$col} ] : undef; - } - push @new_data, $new_datum; - } - - my $identity_col = List::Util::first - { $source->column_info($_)->{is_auto_increment} } @source_columns; - -# bcp identity index is 1-based - my $identity_idx = exists $new_idx{$identity_col} ? - $new_idx{$identity_col} + 1 : 0; - -## Set a client-side conversion error handler, straight from DBD::Sybase docs. -# This ignores any data conversion errors detected by the client side libs, as -# they are usually harmless. - my $orig_cslib_cb = DBD::Sybase::set_cslib_cb( - Sub::Name::subname insert_bulk => sub { - my ($layer, $origin, $severity, $errno, $errmsg, $osmsg, $blkmsg) = @_; - - return 1 if $errno == 36; - - carp - "Layer: $layer, Origin: $origin, Severity: $severity, Error: $errno" . - ($errmsg ? "\n$errmsg" : '') . - ($osmsg ? "\n$osmsg" : '') . - ($blkmsg ? "\n$blkmsg" : ''); - - return 0; - }); - - eval { - my $bulk = $self->_bulk_storage; - - my $guard = $bulk->txn_scope_guard; - -## XXX get this to work instead of our own $sth -## will require SQLA or *Hacks changes for ordered columns -# $bulk->next::method($source, \@source_columns, \@new_data, { -# syb_bcp_attribs => { -# identity_flag => $is_identity_insert, -# identity_column => $identity_idx, -# } -# }); - my $sql = 'INSERT INTO ' . - $bulk->sql_maker->_quote($source->name) . ' (' . -# colname list is ignored for BCP, but does no harm - (join ', ', map $bulk->sql_maker->_quote($_), @source_columns) . ') '. - ' VALUES ('. (join ', ', ('?') x @source_columns) . ')'; - -## XXX there's a bug in the DBD::Sybase bulk support that makes $sth->finish for -## a prepare_cached statement ineffective. Replace with ->sth when fixed, or -## better yet the version above. Should be fixed in DBD::Sybase . - my $sth = $bulk->_get_dbh->prepare($sql, -# 'insert', # op - { - syb_bcp_attribs => { - identity_flag => $is_identity_insert, - identity_column => $identity_idx, - } - } - ); - - $bulk->_query_start($sql); - - for my $datum (@new_data) { - $sth->execute(@$datum); - die $sth->errstr if $sth->errstr; # just in case - } - - $guard->commit; - $sth->finish; - - $bulk->_query_end($sql); - }; - my $exception = $@; - if ($exception =~ /-Y option/) { - carp <<"EOF"; - -Sybase bulk API operation failed due to character set incompatibility, reverting -to regular array inserts: - -*** Try unsetting the LANG environment variable. + $self->next::method(@_); -$@ -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) if $exception; + if ($is_identity_insert) { + $self->_unset_identity_insert ($source->name); } - - DBD::Sybase::set_cslib_cb($orig_cslib_cb); } +### end of stolen insert_bulk section + +# Make sure blobs are not bound as placeholders, and return any non-empty ones +# as a hash. sub _remove_blob_cols { my ($self, $source, $fields) = @_; @@ -620,8 +509,14 @@ sub _remove_blob_cols { for my $col (keys %$fields) { if ($self->_is_lob_type($source->column_info($col)->{data_type})) { - $blob_cols{$col} = delete $fields->{$col}; - $fields->{$col} = \"''"; + my $blob_val = delete $fields->{$col}; + if (not defined $blob_val) { + $fields->{$col} = \'NULL'; + } + else { + $fields->{$col} = \"''"; + $blob_cols{$col} = $blob_val unless $blob_val eq ''; + } } } @@ -633,7 +528,7 @@ sub _update_blobs { my (@primary_cols) = $source->primary_columns; - croak "Cannot update TEXT/IMAGE column(s) without a primary key" + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key') unless @primary_cols; # check if we're updating a single row by PK @@ -663,17 +558,16 @@ sub _insert_blobs { my ($self, $source, $blob_cols, $row) = @_; my $dbh = $self->_get_dbh; - my $table = $source->from; + my $table = $source->name; my %row = %$row; my (@primary_cols) = $source->primary_columns; - croak "Cannot update TEXT/IMAGE column(s) without a primary key" + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without a primary key') unless @primary_cols; - if ((grep { defined $row{$_} } @primary_cols) != @primary_cols) { - croak "Cannot update TEXT/IMAGE column(s) without primary key values"; - } + $self->throw_exception('Cannot update TEXT/IMAGE column(s) without primary key values') + if ((grep { defined $row{$_} } @primary_cols) != @primary_cols); for my $col (keys %$blob_cols) { my $blob = $blob_cols->{$col}; @@ -684,6 +578,14 @@ sub _insert_blobs { $cursor->next; my $sth = $cursor->sth; + if (not $sth) { + + $self->throw_exception( + "Could not find row in table '$table' for blob update:\n" + . $self->_pretty_print (\%where) + ); + } + eval { do { $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr; @@ -707,12 +609,12 @@ sub _insert_blobs { $sth->finish if $sth; if ($exception) { if ($self->using_freetds) { - croak ( + $self->throw_exception ( 'TEXT/IMAGE operation failed, probably because you are using FreeTDS: ' . $exception ); } else { - croak $exception; + $self->throw_exception($exception); } } } @@ -769,18 +671,10 @@ sub datetime_parser_type { "DateTime::Format::Sybase" } sub _dbh_begin_work { my $self = shift; - -# bulkLogin=1 connections are always in a transaction, and can only call BEGIN -# TRAN once. However, we need to make sure there's a $dbh. - return if $self->_is_bulk_storage && $self->_dbh && $self->_began_bulk_work; - $self->next::method(@_); - if ($self->using_freetds) { $self->_get_dbh->do('BEGIN TRAN'); } - - $self->_began_bulk_work(1) if $self->_is_bulk_storage; } sub _dbh_commit { @@ -952,24 +846,6 @@ C command on connection. See L for a L setting you need to work with C columns. -=head1 BULK API - -The experimental L Bulk API support is used for -L in B context, in a transaction -on a separate connection. - -To use this feature effectively, use a large number of rows for each -L call, eg.: - - while (my $rows = $data_source->get_100_rows()) { - $rs->populate($rows); - } - -B the L -calls in your C classes B list columns in database order for this -to work. Also, you may have to unset the C environment variable before -loading your app, if it doesn't match the character set of your database. - =head1 AUTHOR See L.