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-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=74113bd1f2506a481f7938d8f55ecbde5d742c6e;p=dbsrgits%2FDBIx-Class-Historic.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. --- 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 82929a6..13d47c7 100644 --- a/Changes +++ b/Changes @@ -6,6 +6,7 @@ Revision history for DBIx::Class specific DateTime::Format dependencies * Fixes + - Fix updating multiple CLOB/BLOB columns on Oracle - Fix incorrect collapsing-parser source being generated in the presence of unicode data among the collapse-points - Fix endless loop on BareSourcelessResultClass->throw_exception(...) 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 fb330c6..c4ddf9a 100644 --- a/t/73oracle_blob.t +++ b/t/73oracle_blob.t @@ -9,6 +9,21 @@ use Sub::Name; use Try::Tiny; 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; $ENV{NLS_SORT} = "BINARY"; @@ -81,7 +96,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}}; @@ -94,6 +109,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)' @@ -118,13 +135,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 }) @@ -155,7 +174,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