Bug 16229: Deep copy on setting in cache

Koha::Cache->set_in_cache should deep copy (if needed) to avoid the
value which has been set in cache to be unintentionally modified later.

Signed-off-by: Jacek Ablewicz <abl@biblos.pk.edu.pl>
Signed-off-by: Tomas Cohen Arazi <tomascohen@unc.edu.ar>
Signed-off-by: Brendan Gallagher <bredan@bywatersolutions.com>

diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index 0c9558d..c717c5a 100644 (file)
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -281,6 +281,7 @@ sub set_in_cache {
     $expiry //= $self->{timeout};
     my $set_sub = $self->{ref($self->{$cache}) . "_set"};
 
+    $value = clone $value;
     # Set in L1 cache
     $L1_cache{ $key } = $value;
 

diff --git a/t/Cache.t b/t/Cache.t
index fa20a45..8fa96e6 100644 (file)
--- a/t/Cache.t
+++ b/t/Cache.t
@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 38;
+use Test::More tests => 39;
 
 my $destructorcount = 0;
 
@@ -196,6 +196,8 @@ SKIP: {
     $item_from_cache = $cache->get_from_cache('test_deep_copy_hash');
     %$item_from_cache = ( another => 'hashref' );
     is_deeply( $cache->get_from_cache('test_deep_copy_hash'), { a => 'hashref' }, 'A hash will be deep copied');
+    %item = ( a_modified => 'hashref' );
+    is_deeply( $cache->get_from_cache('test_deep_copy_hash'), { a => 'hashref' }, 'A hash will be deep copied when set in cache');
     $item_from_cache = $cache->get_from_cache('test_deep_copy_hash', { unsafe => 1});
     %$item_from_cache = ( another => 'hashref' );
     is_deeply( $cache->get_from_cache('test_deep_copy_hash'), { another => 'hashref' }, 'A hash will not be deep copied if the unsafe flag is set');