From 6149201b2ed634334b56a326482ae98e50448e29 Mon Sep 17 00:00:00 2001 From: Jacek Ablewicz Date: Wed, 13 Apr 2016 13:47:39 +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 very sub-optimal (i.e., 2-3x slower after Bug 16044); this patch addresses that particular issue. It also fixes some borderline "safety" isuess remaining after Bug 16044 (i.e., 1st get_from_cache() call being implicitly unsafe etc.) and provides the ability to intermix "safe" and "unsafe" cache feches, 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.) 4) after Bug 16044 + Bug 16166, GetMarcStructure() should be faster than before, in all possible circumstances 5) prove t/Cache.t 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 '-CF1' --- Koha/Cache.pm | 55 ++++++++++++++++++++++++++++++++++++++++++------------- t/Cache.t | 4 ++-- 2 files changed, 44 insertions(+), 15 deletions(-) diff --git a/Koha/Cache.pm b/Koha/Cache.pm index 8370d3e..2d05f81 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 Clone qw( clone ); +use Storable qw(freeze thaw); use Module::Load::Conditional qw(can_load); use Koha::Cache::Object; @@ -281,9 +281,17 @@ sub set_in_cache { $expiry //= $self->{timeout}; my $set_sub = $self->{ref($self->{$cache}) . "_set"}; + 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 @@ -321,21 +329,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 clone $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; + 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 diff --git a/t/Cache.t b/t/Cache.t index 8adaf1c..6f74f90 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -183,7 +183,7 @@ SKIP: { 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'); + is_deeply( $cache->get_from_cache('test_deep_copy_array', { unsafe => 1 }), [ 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); @@ -192,7 +192,7 @@ SKIP: { 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'); + is_deeply( $cache->get_from_cache('test_deep_copy_hash', { unsafe => 1 }), { another => 'hashref' }, 'A hash will not be deep copied if the unsafe flag is set'); } END { -- 1.7.10.4