From 9e085d835a6e606e0633b43fa1f8d0c54a9c4eca Mon Sep 17 00:00:00 2001 From: Jacek Ablewicz Date: Tue, 26 Apr 2016 08:43:12 +0200 Subject: [PATCH] Bug 16166: Improve L1 cache performance and safety Bug 16044 introduced two-level caching mechanism to Koha::Cache. By default, get_from_cache() returns a deep copy of the data structures stored in L1 cache (aka "safe mode"). For extremely big and/or complex data structures (like MARC framework hash-of-hashes-of-hashes returned by GetMarcStructure() ), deep-cloning is currently sub-optimal; this patch addresses that particular issue. It also provides an ability to intermix "safe" and "unsafe" cache feches, in such way that they don't interfere with each other (i.e., eliminating the risk involved with "unsafe" calls possibly compromising further "safe" calls). Test plan: 1) apply patch 2) flush L2 cache if necessary (restart memcached daemon) 3) profile GetMarcStructure() calls before / after patch, e.g. by running some script which calls it often (like catalogue search w/ XSLT processing turned on, etc.) - GetMarcStructure() should be faster than before, in all possible circumstances (eg. 18 msec per call -> 10 msec p/call) 5) prove -v t/Cache.t - all 39 tests should pass; if you see something like 'ok 39 # skip Cache not enabled', it means that cache is not active and you need to manually revert Bug 16104 first 6) after testing, before returning to the master branch, flush L2 cache again (restart memcached daemon) - otherwise all system preferences returned from L2 cache would be suffixed with '-CF0' --- Koha/Cache.pm | 70 +++++++++++++++++++++++++++++++++++---------------------- 1 file changed, 43 insertions(+), 27 deletions(-) diff --git a/Koha/Cache.pm b/Koha/Cache.pm index 23dece2..d1955d8 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -38,7 +38,7 @@ The first, traditional OO interface provides the following functions: use strict; use warnings; use Carp; -use Storable qw(dclone); +use Storable qw(freeze thaw); use Module::Load::Conditional qw(can_load); use Koha::Cache::Object; @@ -242,13 +242,6 @@ The possible options are: Expiry time of this cached entry in seconds. -=item unsafe - -If set, this will avoid performing a deep copy of the item. This -means that it won't be safe if something later modifies the result of the -function. It should be used with caution, and could save processing time -in some situations where is safe to use it. - =item cache The cache object to use if you want to provide your own. It should be an @@ -267,7 +260,6 @@ 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. @@ -282,12 +274,17 @@ sub set_in_cache { $expiry //= $self->{timeout}; my $set_sub = $self->{ref($self->{$cache}) . "_set"}; - # Deep copy if it's not a scalar and unsafe is not passed - $value = dclone( $value ) if ref($value) and not $unsafe; - + my $flag = '-CF0'; # 0: scalar, 1: frozen data structure # Set in L1 cache - $L1_cache{ $key } = $value; + if (ref($value)) { + $value = freeze($value); + $L1_cache{$key}->{frozen} = $value; + $flag = '-CF1'; + } else { + $L1_cache{$key} = $value; + } + $value .= $flag; # We consider an expiry of 0 to be inifinite if ( $expiry ) { return $set_sub @@ -305,7 +302,7 @@ sub set_in_cache { my $value = $cache->get_from_cache($key, [ $options ]); -Retrieve the value stored under the specified key in the default cache. +Retrieve the value stored under the specified key in the cache. The possible options are: @@ -338,23 +335,42 @@ sub get_from_cache { # Return L1 cache value if exists if ( exists $L1_cache{$key} ) { - # No need to deep copy if it's a scalar - # Or if we do not need to deep copy - return $L1_cache{$key} - if not ref $L1_cache{$key} or $unsafe; - return dclone $L1_cache{$key}; + if (ref($L1_cache{$key})) { + if ($unsafe) { + $L1_cache{$key}->{thawed} ||= thaw($L1_cache{$key}->{frozen}); + return $L1_cache{$key}->{thawed}; + } else { + return thaw($L1_cache{$key}->{frozen}); + } + } else { + # No need to thaw if it's a scalar + return $L1_cache{$key}; + } } my $get_sub = $self->{ref($self->{$cache}) . "_get"}; - my $value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); - - # Update the L1 cache when fetching the L2 cache - # Otherwise the L1 cache won't ever be populated - $L1_cache{$key} = $value; - - $value = dclone $value if ref $L1_cache{$key} and not $unsafe; + my $L2_value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); + + return if ref($L2_value); + return unless (defined($L2_value) && length($L2_value) >= 4); + + my $flag = substr($L2_value, -4, 4, ''); + if ($flag eq '-CF0') { + # it's a scalar + $L1_cache{$key} = $L2_value; + return $L2_value; + } elsif ($flag eq '-CF1') { + # it's a frozen data structure + my $thawed; + eval { $thawed = thaw($L2_value); }; + return if $@; + $L1_cache{$key}->{frozen} = $L2_value; + $L1_cache{$key}->{thawed} = $thawed if $unsafe; + return $thawed; + } - return $value; + # Unknown value / data type returned from L2 cache + return; } =head2 clear_from_cache -- 1.7.10.4