Bug 16229: Add the unsafe flag to set_in_cache

Could be useful 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>

Koha/Cache.pm

@@ -267,6 +267,7 @@ sub set_in_cache {
         $new_options->{cache} = $_cache if defined $_cache;
         $options = $new_options;
     }
+    my $unsafe = $options->{unsafe} || 0;
 
     # the key mustn't contain whitespace (or control characters) for memcache
     # but shouldn't be any harm in applying it globally.
@@ -281,7 +282,9 @@ sub set_in_cache {
     $expiry //= $self->{timeout};
     my $set_sub = $self->{ref($self->{$cache}) . "_set"};
 
-    $value = clone $value;
+    # Deep copy if it's not a scalar and unsafe is not passed
+    $value = clone( $value ) if ref($value) and not $unsafe;
+
     # Set in L1 cache
     $L1_cache{ $key } = $value;
 

t/Cache.t

@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 39;
+use Test::More tests => 40;
 
 my $destructorcount = 0;
 
@@ -196,8 +196,15 @@ 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 = ( a => 'hashref' );
+    $cache->set_in_cache('test_deep_copy_hash', \%item, { unsafe => 1});
+    %item = ( a_modified => 'hashref' );
+    is_deeply( $cache->get_from_cache('test_deep_copy_hash'), { a_modified => 'hashref' }, 'A hash will not be deep copied when set in cache if the unsafe flag is set');
+
     $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');