From a274e765821c57c3e8b6aa6f558165d88bb2e418 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 16044: (followup) only clear L1 cache when needed

---
 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