From bc2a946f7c331b3535c1a5c6a31534b4ca8aa7fd Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Tue, 15 Mar 2016 16:40:14 +0000 Subject: [PATCH] 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 Signed-off-by: Tomas Cohen Arazi Signed-off-by: Brendan A Gallagher (cherry picked from commit b0bbace4dd8c19488110bf5c06817077abaa3f1c) Signed-off-by: Julian Maurice --- Koha/Cache.pm | 17 ++++++++++++----- t/Cache.t | 10 ++++++++-- 2 files changed, 20 insertions(+), 7 deletions(-) diff --git a/Koha/Cache.pm b/Koha/Cache.pm index 9d0a23e3e2..0df003f9e5 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -285,25 +285,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 1780025667..8adaf1c927 100644 --- 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 { -- 2.39.5