From: Kevin L. Kane Date: Tue, 18 Nov 2014 13:02:33 +0000 (-0500) Subject: Fix updating multiple CLOB/BLOB columns on Oracle X-Git-Tag: v0.082820~13 X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=3d02b69a7f40276c2791f06c8566e49b91f58441;p=dbsrgits%2FDBIx-Class.git Fix updating multiple CLOB/BLOB columns on Oracle The genric _dbi_attrs_for_bind caches the attribute hashrefs by data type, so we can't modify them directly with column-specific data. Instead, copy it and add the ora_field attribute to the copy. (cherry pick of 74113bd1) --- diff --git a/AUTHORS b/AUTHORS index 180d485..6a9f6ef 100644 --- a/AUTHORS +++ b/AUTHORS @@ -104,6 +104,7 @@ Jordan Metzmeier jshirley: J. Shirley kaare: Kaare Rasmussen kd: Kieren Diment +kkane: Kevin L. Kane konobi: Scott McWhirter lejeunerenard: Sean Zellmer littlesavage: Alexey Illarionov diff --git a/Changes b/Changes index 9f3688f..46356f4 100644 --- a/Changes +++ b/Changes @@ -3,6 +3,7 @@ Revision history for DBIx::Class * Fixes - Protect destructors from rare but possible double execution, and loudly warn the user whenever the problem is encountered (GH#63) + - Fix updating multiple CLOB/BLOB columns on Oracle - Fix hang in t/72pg.t when run against DBD::Pg 3.5.0. The ping() implementation changes due to RT#100648 made an alarm() based timeout lock-prone. diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm index 2b4ce75..636e40e 100644 --- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm +++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm @@ -419,11 +419,17 @@ sub _dbi_attrs_for_bind { my $attrs = $self->next::method($ident, $bind); - for my $i (0 .. $#$attrs) { - if (keys %{$attrs->[$i]||{}} and my $col = $bind->[$i][0]{dbic_colname}) { - $attrs->[$i]{ora_field} = $col; - } - } + # Push the column name into all bind attrs, make sure to *NOT* write into + # the existing $attrs->[$idx]{..} hashref, as it is cached by the call to + # next::method above. + $attrs->[$_] + and + keys %{ $attrs->[$_] } + and + $bind->[$_][0]{dbic_colname} + and + $attrs->[$_] = { %{$attrs->[$_]}, ora_field => $bind->[$_][0]{dbic_colname} } + for 0 .. $#$attrs; $attrs; } diff --git a/t/73oracle_blob.t b/t/73oracle_blob.t index 2a78d36..22a98c4 100644 --- a/t/73oracle_blob.t +++ b/t/73oracle_blob.t @@ -8,6 +8,21 @@ use Try::Tiny; use DBIx::Class::Optional::Dependencies (); use lib qw(t/lib); + +use DBICTest::Schema::BindType; +BEGIN { + DBICTest::Schema::BindType->add_columns( + 'blb2' => { + data_type => 'blob', + is_nullable => 1, + }, + 'clb2' => { + data_type => 'clob', + is_nullable => 1, + } + ); +} + use DBICTest; my ($dsn, $user, $pass) = @ENV{map { "DBICTEST_ORA_${_}" } qw/DSN USER PASS/}; @@ -86,7 +101,7 @@ SKIP: { my $str = $binstr{$size}; lives_ok { - $rs->create( { 'id' => $id, blob => "blob:$str", clob => "clob:$str" } ) + $rs->create( { 'id' => $id, blob => "blob:$str", clob => "clob:$str", blb2 => "blb2:$str", clb2 => "clb2:$str" } ) } "inserted $size without dying"; my %kids = %{$schema->storage->_dbh->{CachedKids}}; @@ -99,6 +114,8 @@ SKIP: { is @objs, 1, 'One row found matching on both LOBs'; ok (try { $objs[0]->blob }||'' eq "blob:$str", 'blob inserted/retrieved correctly'); ok (try { $objs[0]->clob }||'' eq "clob:$str", 'clob inserted/retrieved correctly'); + ok (try { $objs[0]->clb2 }||'' eq "clb2:$str", "clb2 inserted correctly"); + ok (try { $objs[0]->blb2 }||'' eq "blb2:$str", "blb2 inserted correctly"); { local $TODO = '-like comparison on blobs not tested before ora 10 (fails on 8i)' @@ -123,13 +140,15 @@ SKIP: { lives_ok { $rs->search({ id => $id, blob => "blob:$str", clob => "clob:$str" }) - ->update({ blob => 'updated blob', clob => 'updated clob' }); + ->update({ blob => 'updated blob', clob => 'updated clob', clb2 => 'updated clb2', blb2 => 'updated blb2' }); } 'blob UPDATE with blobs in WHERE clause survived'; @objs = $rs->search({ blob => "updated blob", clob => 'updated clob' })->all; is @objs, 1, 'found updated row'; ok (try { $objs[0]->blob }||'' eq "updated blob", 'blob updated/retrieved correctly'); ok (try { $objs[0]->clob }||'' eq "updated clob", 'clob updated/retrieved correctly'); + ok (try { $objs[0]->clb2 }||'' eq "updated clb2", "clb2 updated correctly"); + ok (try { $objs[0]->blb2 }||'' eq "updated blb2", "blb2 updated correctly"); lives_ok { $rs->search({ id => $id }) @@ -160,7 +179,7 @@ sub do_creates { do_clean($dbh); - $dbh->do("CREATE TABLE ${q}bindtype_test${q} (${q}id${q} integer NOT NULL PRIMARY KEY, ${q}bytea${q} integer NULL, ${q}blob${q} blob NULL, ${q}blob2${q} blob NULL, ${q}clob${q} clob NULL, ${q}clob2${q} clob NULL, ${q}a_memo${q} integer NULL)"); + $dbh->do("CREATE TABLE ${q}bindtype_test${q} (${q}id${q} integer NOT NULL PRIMARY KEY, ${q}bytea${q} integer NULL, ${q}blob${q} blob NULL, ${q}blb2${q} blob NULL, ${q}clob${q} clob NULL, ${q}clb2${q} clob NULL, ${q}a_memo${q} integer NULL)"); } # clean up our mess