X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FDBIx%2FClass%2FStorage%2FDBI%2FSybase.pm;h=27d9f372ec2d4e42094e50c67ce8677187f7720c;hb=f49102d2abafb07215f9760bcfdf02b3502bc632;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..27d9f37 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -20,6 +20,9 @@ __PACKAGE__->mk_group_accessors('simple' => ); my @also_proxy_to_extra_storages = 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 /; @@ -126,6 +129,7 @@ sub _init { $writer_storage->_is_extra_storage(1); $writer_storage->connect_info($self->connect_info); + $writer_storage->auto_cast($self->auto_cast); $self->_writer_storage($writer_storage); @@ -237,6 +241,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 +404,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,19 +437,33 @@ 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]; @@ -429,16 +472,23 @@ sub update { ### the insert_bulk partially 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,18 +497,25 @@ 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 } + sub insert_bulk { my $self = shift; my ($source, $cols, $data) = @_; @@ -575,11 +632,45 @@ EOF } ); + my $bind_attributes = $self->source_bind_attributes($source); + + foreach my $slice_idx (0..$#source_columns) { + my $col = $source_columns[$slice_idx]; + + my $attributes = $bind_attributes->{$col} + if $bind_attributes && defined $bind_attributes->{$col}; + + my @slice = map $_->[$slice_idx], @new_data; + + $sth->bind_param_array(($slice_idx + 1), \@slice, $attributes); + } + $bulk->_query_start($sql); - for my $datum (@new_data) { - $sth->execute(@$datum); - die $sth->errstr if $sth->errstr; # just in case +# this is stolen from DBI::insert_bulk + my $tuple_status = []; + my $rv = eval { $sth->execute_array({ArrayTupleStatus => $tuple_status}) }; + + if (my $err = $@ || $sth->errstr) { + my $i = 0; + ++$i while $i <= $#$tuple_status && !ref $tuple_status->[$i]; + + $self->throw_exception("Unexpected populate error: $err") + if ($i > $#$tuple_status); + + require Data::Dumper; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Useqq = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Sortkeys = 1; + + $self->throw_exception(sprintf "%s for populate slice:\n%s", + ($tuple_status->[$i][1] || $err), + Data::Dumper::Dumper( + { map { $source_columns[$_] => $new_data[$i][$_] } (0 .. $#$cols) } + ), + ); } $guard->commit; @@ -607,12 +698,14 @@ EOF DBD::Sybase::set_cslib_cb($orig_cslib_cb); # rollback makes the bulkLogin connection unusable $self->_bulk_storage->disconnect; - $self->throw_exception($exception) if $exception; + $self->throw_exception($exception); } DBD::Sybase::set_cslib_cb($orig_cslib_cb); } +# 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 +713,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 ''; + } } } @@ -663,7 +762,7 @@ 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; @@ -684,6 +783,18 @@ sub _insert_blobs { $cursor->next; my $sth = $cursor->sth; + if (not $sth) { + require Data::Dumper; + local $Data::Dumper::Terse = 1; + local $Data::Dumper::Indent = 1; + local $Data::Dumper::Useqq = 1; + local $Data::Dumper::Quotekeys = 0; + local $Data::Dumper::Sortkeys = 1; + + croak "\nCould not find row in table '$table' for blob update:\n". + Data::Dumper::Dumper(\%where)."\n"; + } + eval { do { $sth->func('CS_GET', 1, 'ct_data_info') or die $sth->errstr; @@ -970,6 +1081,9 @@ 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. +When inserting IMAGE columns using this method, you'll need to use +L as well. + =head1 AUTHOR See L.