Bug 16044: Add an unsafe flag to Koha::Cache->get_from_cache

If the caller/developer knows what he is doing, he can decide not to
deep copy the structure. It will be faster but unsafe!
If the structure is modified, the cache will also be updated.
This option must be used with care and is not the default behavior.

Signed-off-by: Jesse Weaver <jweaver@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>
Signed-off-by: Brendan A Gallagher <brendan@bywatersolutions.com>

diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index f389395..d3d52ec 100644 (file)
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -299,25 +299,32 @@ sub set_in_cache {
 
 =head2 get_from_cache
 
-    my $value = $cache->get_from_cache($key);
+    my $value = $cache->get_from_cache($key, [ $options ]);
 
 Retrieve the value stored under the specified key in the default cache.
 
+The options can set an unsafe flag to avoid a deep copy.
+When this flag is set, you have to know what you are doing!
+If you are retrieving a structure and modify it, you will modify the contain
+of the cache!
+
 =cut
 
 sub get_from_cache {
-    my ( $self, $key, $cache ) = @_;
+    my ( $self, $key, $options ) = @_;
+    my $cache  = $options->{cache}  || 'cache';
+    my $unsafe = $options->{unsafe} || 0;
     $key =~ s/[\x00-\x20]/_/g;
-    $cache ||= 'cache';
     croak "No key" unless $key;
     $ENV{DEBUG} && carp "get_from_cache for $key";
     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
 
     # Return L1 cache value if exists
     if ( exists $L1_cache{$key} ) {
-        # No need to deep copy if it's a scalar:
+        # No need to deep copy if it's a scalar
+        # Or if we do not need to deep copy
         return $L1_cache{$key}
-            unless ref $L1_cache{$key};
+            if not ref $L1_cache{$key} or $unsafe;
         return clone $L1_cache{$key};
     }
 

diff --git a/t/Cache.t b/t/Cache.t
index 1780025..8adaf1c 100644 (file)
--- a/t/Cache.t
+++ b/t/Cache.t
@@ -17,7 +17,7 @@
 
 use Modern::Perl;
 
-use Test::More tests => 35;
+use Test::More tests => 37;
 
 my $destructorcount = 0;
 
@@ -33,7 +33,7 @@ SKIP: {
     $ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';
     my $cache = Koha::Cache->get_instance();
 
-    skip "Cache not enabled", 31
+    skip "Cache not enabled", 33
       unless ( $cache->is_cache_active() && defined $cache );
 
     # test fetching an item that isnt in the cache
@@ -181,12 +181,18 @@ SKIP: {
     $item_from_cache = $cache->get_from_cache('test_deep_copy_array');
     @$item_from_cache = qw( another array ref );
     is_deeply( $cache->get_from_cache('test_deep_copy_array'), [ qw ( an array ref ) ], 'An array will be deep copied');
+    $item_from_cache = $cache->get_from_cache('test_deep_copy_array', { unsafe => 1 });
+    @$item_from_cache = qw( another array ref );
+    is_deeply( $cache->get_from_cache('test_deep_copy_array'), [ qw ( another array ref ) ], 'An array will not be deep copied if the unsafe flag is set');
     # Hash
     my %item = ( a => 'hashref' );
     $cache->set_in_cache('test_deep_copy_hash', \%item);
     $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_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');
 }
 
 END {