From 92cee449ce7560448f3e2e3d05029d8cfee0cc47 Mon Sep 17 00:00:00 2001
From: Jesse Weaver <jweaver@bywatersolutions.com>
Date: Fri, 11 Mar 2016 13:19:49 -0600
Subject: [PATCH] Bug 16140: Only clear L1 cache when needed

By storing a modification time in memcached, we can check the upstream
cache at the start of every request, and only clear the L1 cache if the
upstream has actually been modified.

This and the following patch get noticeable performance improvements on
top of bug 16044: ~1.2 vs 2.2 seconds for a search on a small dataset.
---
 C4/Koha.pm                  | 28 ++++++++++++++--------------
 Koha/Cache.pm               | 26 +++++++++++++++++++++++++-
 debian/templates/plack.psgi |  2 +-
 misc/plack/koha.psgi        |  2 +-
 4 files changed, 41 insertions(+), 17 deletions(-)

diff --git a/C4/Koha.pm b/C4/Koha.pm
index 6981ebf..4fda49b 100644
--- a/C4/Koha.pm
+++ b/C4/Koha.pm
@@ -1013,6 +1013,13 @@ C<$opac> If set to a true value, displays OPAC descriptions rather than normal o
 
 =cut
 
+sub _AddSelectedAuthVal {
+    my ( $authorised_values, $selected ) = @_;
+    foreach my $data ( @$authorised_values ) {
+        $data->{selected} = $selected eq $data->{authorised_value} ? 1 : 0;
+    }
+}
+
 sub GetAuthorisedValues {
     my ( $category, $selected, $opac ) = @_;
 
@@ -1025,12 +1032,14 @@ sub GetAuthorisedValues {
     $opac = $opac ? 1 : 0;    # normalise to be safe
     my $branch_limit =
       C4::Context->userenv ? C4::Context->userenv->{"branch"} : "";
-    my $selected_key = defined($selected) ? $selected : '';
     my $cache_key =
-      "AuthorisedValues-$category-$selected_key-$opac-$branch_limit";
+      "AuthorisedValues-$category-$opac-$branch_limit";
     my $cache  = Koha::Cache->get_instance();
     my $result = $cache->get_from_cache($cache_key);
-    return $result if $result;
+    if ($result) {
+        _AddSelectedAuthVal( $result, $selected ) if defined $selected;
+        return $result;
+    }
 
     my @results;
     my $dbh      = C4::Context->dbh;
@@ -1064,13 +1073,6 @@ sub GetAuthorisedValues {
 
     $sth->execute( @where_args );
     while (my $data=$sth->fetchrow_hashref) {
-        if ( defined $selected and $selected eq $data->{authorised_value} ) {
-            $data->{selected} = 1;
-        }
-        else {
-            $data->{selected} = 0;
-        }
-
         if ($opac && $data->{lib_opac}) {
             $data->{lib} = $data->{lib_opac};
         }
@@ -1078,10 +1080,8 @@ sub GetAuthorisedValues {
     }
     $sth->finish;
 
-    # We can't cache for long because of that "selected" thing which
-    # makes it impossible to clear the cache without iterating through every
-    # value, which sucks. This'll cover this request, and not a whole lot more.
-    $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1, expiry => 5 } );
+    $cache->set_in_cache( $cache_key, \@results, { deepcopy => 1 } );
+    _AddSelectedAuthVal( \@results, $selected );
     return \@results;
 }
 
diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index d3d52ec..a515b7c 100644
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -41,6 +41,7 @@ use Carp;
 use Clone qw( clone );
 use Module::Load::Conditional qw(can_load);
 use Koha::Cache::Object;
+use Time::HiRes qw(time);
 
 use base qw(Class::Accessor);
 
@@ -48,6 +49,7 @@ __PACKAGE__->mk_ro_accessors(
     qw( cache memcached_cache fastmmap_cache memory_cache ));
 
 our %L1_cache;
+our $L1_cache_time;
 
 =head2 get_instance
 
@@ -131,6 +133,22 @@ sub new {
       $class;
 }
 
+sub flush_L1_if_needed {
+    my ($self) = @_;
+
+    if ( $self->{cache} ) {
+        if ( $L1_cache_time ) {
+            my $upstream_cache_mtime = $self->{cache}->get('upstream_cache_mtime');
+
+            if ( $upstream_cache_mtime && $upstream_cache_mtime > $L1_cache_time ) {
+                $self->flush_L1_cache();
+            }
+        }
+
+        $L1_cache_time = time();
+    }
+}
+
 sub _initialize_memcached {
     my ($self) = @_;
     my @servers =
@@ -284,6 +302,8 @@ sub set_in_cache {
     # Set in L1 cache
     $L1_cache{ $key } = $value;
 
+    $self->{$cache}->set( 'upstream_cache_mtime', time() );
+
     # We consider an expiry of 0 to be inifinite
     if ( $expiry ) {
         return $set_sub
@@ -329,7 +349,11 @@ sub get_from_cache {
     }
 
     my $get_sub = $self->{ref($self->{$cache}) . "_get"};
-    return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
+    my $value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
+
+    $L1_cache{$key} = $value;
+
+    return $value;
 }
 
 =head2 clear_from_cache
diff --git a/debian/templates/plack.psgi b/debian/templates/plack.psgi
index 995fa72..9c92933 100644
--- a/debian/templates/plack.psgi
+++ b/debian/templates/plack.psgi
@@ -44,7 +44,7 @@ use CGI qw(-utf8 ); # we will loose -utf8 under plack, otherwise
     *CGI::new = sub {
         my $q = $old_new->( @_ );
         $CGI::PARAM_UTF8 = 1;
-        Koha::Cache->flush_L1_cache();
+        Koha::Cache->flush_L1_if_needed();
         return $q;
     };
 }
diff --git a/misc/plack/koha.psgi b/misc/plack/koha.psgi
index d14755d..4002b3b 100644
--- a/misc/plack/koha.psgi
+++ b/misc/plack/koha.psgi
@@ -12,7 +12,7 @@ use CGI qw(-utf8 ); # we will loose -utf8 under plack
     *CGI::new = sub {
         my $q = $old_new->( @_ );
         $CGI::PARAM_UTF8 = 1;
-        Koha::Cache->flush_L1_cache();
+        Koha::Cache->flush_L1_if_needed();
         return $q;
     };
 }
-- 
2.7.0