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 350654c..abdea35 100644 (file)
--- a/AUTHORS
+++ b/AUTHORS
@@ -104,6 +104,7 @@ Jordan Metzmeier <jmetzmeier@magazines.com>
 jshirley: J. Shirley <jshirley@gmail.com>
 kaare: Kaare Rasmussen
 kd: Kieren Diment <diment@gmail.com>
+kkane: Kevin L. Kane <kevin.kane@gmail.com>
 konobi: Scott McWhirter <konobi@cpan.org>
 Lasse Makholm <lasse@unity3d.com>
 lejeunerenard: Sean Zellmer <sean@lejeunerenard.com>

diff --git a/Changes b/Changes
index a65fd89..890f685 100644 (file)
--- a/Changes
+++ b/Changes
@@ -2,6 +2,7 @@ Revision history for DBIx::Class
 
     * Fixes
         - Silence with_deferred_fk_checks() warning on PostgreSQL 9.4
+        - Fix updating multiple CLOB/BLOB columns on Oracle
 
     * Misc
         - Speed up skipping CDBICompat tests when dependencies are missing

diff --git a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
index 2b4ce75..695d432 100644 (file)
--- a/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
+++ b/lib/DBIx/Class/Storage/DBI/Oracle/Generic.pm
@@ -421,7 +421,7 @@ sub _dbi_attrs_for_bind {
 
   for my $i (0 .. $#$attrs) {
     if (keys %{$attrs->[$i]||{}} and my $col = $bind->[$i][0]{dbic_colname}) {
-      $attrs->[$i]{ora_field} = $col;
+      $attrs->[$i] = { %{$attrs->[$i]}, ora_field => $col };
     }
   }
 

diff --git a/t/72pg_bytea.t b/t/72pg_bytea.t
index 186ac89..c18faba 100644 (file)
--- a/t/72pg_bytea.t
+++ b/t/72pg_bytea.t
@@ -41,7 +41,9 @@ my $dbh = $schema->storage->dbh;
             id              serial       NOT NULL   PRIMARY KEY,
             bytea           bytea        NULL,
             blob            bytea        NULL,
+            blob2           bytea        NULL,
             clob            text         NULL,
+            clob2           text         NULL,
             a_memo          text         NULL
         );
     ],{ RaiseError => 1, PrintError => 1 });

diff --git a/t/73oracle_blob.t b/t/73oracle_blob.t
index e3b89b8..20a680e 100644 (file)
--- a/t/73oracle_blob.t
+++ b/t/73oracle_blob.t
@@ -59,7 +59,7 @@ SKIP: {
   my %binstr = ( 'small' => join('', map { chr($_) } ( 1 .. 127 )) );
   $binstr{'large'} = $binstr{'small'} x 1024;
 
-  my $maxloblen = (length $binstr{'large'}) + 5;
+  my $maxloblen = (length $binstr{'large'}) + 6;
   note "Localizing LongReadLen to $maxloblen to avoid truncation of test data";
   local $dbh->{'LongReadLen'} = $maxloblen;
 
@@ -86,7 +86,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", blob2 => "blob2:$str", clob2 => "clob2:$str" } )
     } "inserted $size without dying";
 
     my %kids = %{$schema->storage->_dbh->{CachedKids}};
@@ -99,6 +99,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]->clob2 }||'' eq "clob2:$str", "clob2 inserted correctly");
+    ok (try { $objs[0]->blob2 }||'' eq "blob2:$str", "blob2 inserted correctly");
 
     {
       local $TODO = '-like comparison on blobs not tested before ora 10 (fails on 8i)'
@@ -123,13 +125,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', clob2 => 'updated clob2', blob2 => 'updated blob2' });
     } '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]->clob2 }||'' eq "updated clob2", "clob2 updated correctly");
+    ok (try { $objs[0]->blob2 }||'' eq "updated blob2", "blob2 updated correctly");
 
     lives_ok {
       $rs->search({ id => $id  })

diff --git a/t/746sybase.t b/t/746sybase.t
index a8356ba..a6729ec 100644 (file)
--- a/t/746sybase.t
+++ b/t/746sybase.t
@@ -350,7 +350,9 @@ SQL
           id     INT   IDENTITY PRIMARY KEY,
           bytea  IMAGE NULL,
           blob   IMAGE NULL,
+          blob2  IMAGE NULL,
           clob   TEXT  NULL,
+          clob2  TEXT  NULL,
           a_memo IMAGE NULL
         )
       ],{ RaiseError => 1, PrintError => 0 });

diff --git a/t/747mssql_ado.t b/t/747mssql_ado.t
index 19362dd..9ae7eb1 100644 (file)
--- a/t/747mssql_ado.t
+++ b/t/747mssql_ado.t
@@ -252,7 +252,9 @@ CREATE TABLE bindtype_test
   id     INT IDENTITY NOT NULL PRIMARY KEY,
   bytea  INT NULL,
   blob   IMAGE NULL,
+  blob2  IMAGE NULL,
   clob   TEXT NULL,
+  clob2  TEXT NULL,
   a_memo NTEXT NULL
 )
 ],{ RaiseError => 1, PrintError => 1 });

diff --git a/t/749sqlanywhere.t b/t/749sqlanywhere.t
index 0b66bb5..0999f6d 100644 (file)
--- a/t/749sqlanywhere.t
+++ b/t/749sqlanywhere.t
@@ -151,7 +151,9 @@ EOF
     id     INT          NOT NULL PRIMARY KEY,
     bytea  INT          NULL,
     blob   LONG BINARY  NULL,
+    blob2  LONG BINARY  NULL,
     clob   LONG VARCHAR NULL,
+    clob2  LONG VARCHAR NULL,
     a_memo INT          NULL
   )
   ],{ RaiseError => 1, PrintError => 1 });

diff --git a/t/750firebird.t b/t/750firebird.t
index c1e625a..9a460ea 100644 (file)
--- a/t/750firebird.t
+++ b/t/750firebird.t
@@ -271,7 +271,9 @@ EOF
     "id"     INT PRIMARY KEY,
     "bytea"  INT,
     "blob"   BLOB,
+    "blob2"  BLOB,
     "clob"   BLOB SUB_TYPE TEXT,
+    "clob2"  BLOB SUB_TYPE TEXT,
     "a_memo" INT
   )
   ]);

diff --git a/t/751msaccess.t b/t/751msaccess.t
index cadf140..8ea0e2a 100644 (file)
--- a/t/751msaccess.t
+++ b/t/751msaccess.t
@@ -288,7 +288,9 @@ EOF
       id     INT          NOT NULL PRIMARY KEY,
       bytea  INT          NULL,
       blob   IMAGE        NULL,
+      blob2  IMAGE        NULL,
       clob   TEXT         NULL,
+      clob2  TEXT         NULL,
       a_memo MEMO         NULL
     )
     ],{ RaiseError => 1, PrintError => 1 });

diff --git a/t/lib/DBICTest/Schema/BindType.pm b/t/lib/DBICTest/Schema/BindType.pm
index 97edc8b..f8d7e67 100644 (file)
--- a/t/lib/DBICTest/Schema/BindType.pm
+++ b/t/lib/DBICTest/Schema/BindType.pm
@@ -21,10 +21,18 @@ __PACKAGE__->add_columns(
     data_type => 'blob',
     is_nullable => 1,
   },
+  'blob2' => {
+    data_type => 'blob',
+    is_nullable => 1,
+  },
   'clob' => {
     data_type => 'clob',
     is_nullable => 1,
   },
+  'clob2' => {
+    data_type => 'clob',
+    is_nullable => 1,
+  },
   'a_memo' => {
     data_type => 'memo',
     is_nullable => 1,

diff --git a/t/lib/sqlite.sql b/t/lib/sqlite.sql
index 64ddc33..30ffbee 100644 (file)
--- a/t/lib/sqlite.sql
+++ b/t/lib/sqlite.sql
@@ -15,7 +15,9 @@ CREATE TABLE "bindtype_test" (
   "id" INTEGER PRIMARY KEY NOT NULL,
   "bytea" blob,
   "blob" blob,
+  "blob2" blob,
   "clob" clob,
+  "clob2" clob,
   "a_memo" memo
 );