From: Rafael Kitover Date: Fri, 17 Jul 2009 07:39:54 +0000 (+0000) Subject: make insertion of blobs into tables with identity columns work, other minor fixes X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=9b3dabe0c35b6dafdfec559d594e95d5131e84b5;p=dbsrgits%2FDBIx-Class-Historic.git make insertion of blobs into tables with identity columns work, other minor fixes --- diff --git a/lib/DBIx/Class/Storage/DBI/Sybase.pm b/lib/DBIx/Class/Storage/DBI/Sybase.pm index 5e1e5eb..cc8a0cc 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase.pm @@ -79,7 +79,6 @@ sub _set_maxConnect { if ($dsn !~ /maxConnect=/) { $self->_dbi_connect_info->[0] = "$dsn;maxConnect=256"; - # will take effect next connection my $connected = defined $self->_dbh; $self->disconnect; $self->ensure_connected if $connected; @@ -159,8 +158,10 @@ sub _remove_blob_cols { my %blob_cols; for my $col (keys %$fields) { - $blob_cols{$col} = delete $fields->{$col} - if $self->_is_lob_type($source->column_info($col)->{data_type}); + if ($self->_is_lob_type($source->column_info($col)->{data_type})) { + $blob_cols{$col} = delete $fields->{$col}; + $fields->{$col} = \"''"; + } } return \%blob_cols; @@ -172,28 +173,40 @@ sub _update_blobs { my $table = $source->from; + my %inserted = %$inserted; my (@primary_cols) = $source->primary_columns; - croak "Cannot update TEXT/IMAGE without a primary key!" + croak "Cannot update TEXT/IMAGE column(s) without a primary key" unless @primary_cols; - my $search_cond = join ',' => map "$_ = ?", @primary_cols; + if ((grep { defined $inserted{$_} } @primary_cols) != @primary_cols) { + if (@primary_cols == 1) { + my $col = $primary_cols[0]; + $inserted{$col} = $self->last_insert_id($source, $col); + } else { + croak "Cannot update TEXT/IMAGE column(s) without primary key values"; + } + } for my $col (keys %$blob_cols) { my $blob = $blob_cols->{$col}; + my $sth; -# First update to empty string in case it's NULL, can't update a NULL blob using -# the API. - my $sth = $dbh->prepare_cached( - qq{update $table set $col = '' where $search_cond} - ); - $sth->execute(map $inserted->{$_}, @primary_cols) or die $sth->errstr; - $sth->finish; + 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 $inserted{$_}, @primary_cols); + } else { + my $search_cond = join ',' => map "$_ = $inserted{$_}", @primary_cols; - $sth = $dbh->prepare_cached( - "select $col from $table where $search_cond" - ); - $sth->execute(map $inserted->{$_}, @primary_cols); + $sth = $dbh->prepare( + "select $col from $table where $search_cond" + ); + $sth->execute; + } eval { while ($sth->fetch) { diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm index fd27287..9a9410f 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/Microsoft_SQL_Server.pm @@ -10,6 +10,11 @@ use base qw/ /; use mro 'c3'; +sub _rebless { + my $self = shift; + $self->disable_sth_caching(1); +} + 1; =head1 NAME diff --git a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm index 8c63d8c..9d5cac7 100644 --- a/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm +++ b/lib/DBIx/Class/Storage/DBI/Sybase/NoBindVars.pm @@ -8,6 +8,11 @@ use base qw/ use List::Util (); use Scalar::Util (); +sub _rebless { + my $self = shift; + $self->disable_sth_caching(1); +} + sub _dbh_last_insert_id { my ($self, $dbh, $source, $col) = @_; @@ -39,6 +44,8 @@ sub should_quote_value { if (my $key = List::Util::first { $type =~ /$_/i } keys %noquote) { return 0 if $noquote{$key}->($value); + } elsif($self->is_datatype_numeric($type) && $number->($value)) { + return 0; } ## try to guess based on value diff --git a/t/746sybase.t b/t/746sybase.t index 2eeeb11..f82e3e6 100644 --- a/t/746sybase.t +++ b/t/746sybase.t @@ -15,7 +15,7 @@ if (not ($dsn && $user)) { "\nWarning: This test drops and creates the tables " . "'artist' and 'bindtype_test'"; } else { - plan tests => (27 + 2)*2; + plan tests => (29 + 2)*2; } my @storage_types = ( @@ -125,12 +125,12 @@ SQL $dbh->do(qq[ CREATE TABLE bindtype_test ( - id INT PRIMARY KEY, + id INT IDENTITY PRIMARY KEY, bytea INT NULL, blob IMAGE NULL, clob TEXT NULL ) - ],{ RaiseError => 1, PrintError => 1 }); + ],{ RaiseError => 1, PrintError => 0 }); } my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) ); @@ -141,19 +141,20 @@ SQL local $dbh->{'LongReadLen'} = $maxloblen; my $rs = $schema->resultset('BindType'); - my $id = 0; + my $last_id; foreach my $type (qw(blob clob)) { foreach my $size (qw(small large)) { no warnings 'uninitialized'; - $id++; - eval { $rs->create( { 'id' => $id, $type => $binstr{$size} } ) }; + my $created = eval { $rs->create( { $type => $binstr{$size} } ) }; ok(!$@, "inserted $size $type without dying"); diag $@ if $@; + $last_id = $created->id if $created; + my $got = eval { - $rs->search({ id=> $id }, { select => [$type] })->single->$type + $rs->search({ id => $last_id }, { select => [$type] })->single->$type }; diag $@ if $@; ok($got eq $binstr{$size}, "verified inserted $size $type"); @@ -165,14 +166,39 @@ SQL local $TODO = 'updating TEXT/IMAGE does not work yet'; my $new_str = $binstr{large} . 'foo'; - eval { $rs->search({ id => $id })->update({ blob => $new_str }) }; + eval { $rs->search({ id => $last_id })->update({ blob => $new_str }) }; ok !$@, 'updated blob successfully'; diag $@ if $@; ok(eval { - $rs->search({ id=> $id }, { select => ['blob'] })->single->blob + $rs->search({ id => $last_id }, { select => ['blob'] })->single->blob } eq $new_str, "verified updated blob" ); diag $@ if $@; } + + # blob insert with explicit PK + { + local $SIG{__WARN__} = sub {}; + eval { $dbh->do('DROP TABLE bindtype_test') }; + + $dbh->do(qq[ + CREATE TABLE bindtype_test + ( + id INT PRIMARY KEY, + bytea INT NULL, + blob IMAGE NULL, + clob TEXT NULL + ) + ],{ RaiseError => 1, PrintError => 0 }); + } + my $created = eval { $rs->create( { id => 1, blob => $binstr{large} } ) }; + ok(!$@, "inserted large blob without dying"); + diag $@ if $@; + + my $got = eval { + $rs->search({ id => 1 }, { select => ['blob'] })->single->blob + }; + diag $@ if $@; + ok($got eq $binstr{large}, "verified inserted large blob"); } # clean up our mess