Bug 16044: Use the L1 cache for any objects set in cache

Signed-off-by: Jesse Weaver <jweaver@bywatersolutions.com>
Signed-off-by: Tomas Cohen Arazi <tomascohen@theke.io>

Signed-off-by: Brendan A Gallagher <brendan@bywatersolutions.com>

C4/Context.pm

@@ -513,7 +513,6 @@ with this method.
 =cut
 
 my $syspref_cache = Koha::Cache->get_instance();
-my %syspref_L1_cache;
 my $use_syspref_cache = 1;
 sub preference {
     my $self = shift;
@@ -521,11 +520,6 @@ sub preference {
 
     $var = lc $var;
 
-    # Return the value if the var has already been accessed
-    if ($use_syspref_cache && exists $syspref_L1_cache{$var}) {
-        return $syspref_L1_cache{$var};
-    }
-
     my $cached_var = $use_syspref_cache
         ? $syspref_cache->get_from_cache("syspref_$var")
         : undef;
@@ -542,7 +536,6 @@ sub preference {
 
     if ( $use_syspref_cache ) {
         $syspref_cache->set_in_cache("syspref_$var", $value);
-        $syspref_L1_cache{$var} = $value;
     }
     return $value;
 }
@@ -598,11 +591,6 @@ will not be seen by this process.
 sub clear_syspref_cache {
     return unless $use_syspref_cache;
     $syspref_cache->flush_all;
-    clear_syspref_L1_cache()
-}
-
-sub clear_syspref_L1_cache {
-    %syspref_L1_cache = ();
 }
 
 =head2 set_preference
@@ -655,7 +643,6 @@ sub set_preference {
 
     if ( $use_syspref_cache ) {
         $syspref_cache->set_in_cache( "syspref_$variable", $value );
-        $syspref_L1_cache{$variable} = $value;
     }
 
     return $syspref;
@@ -677,7 +664,6 @@ sub delete_preference {
     if ( Koha::Config::SysPrefs->find( $var )->delete ) {
         if ( $use_syspref_cache ) {
             $syspref_cache->clear_from_cache("syspref_$var");
-            delete $syspref_L1_cache{$var};
         }
 
         return 1;

Koha/Cache.pm

@@ -46,6 +46,8 @@ use base qw(Class::Accessor);
 __PACKAGE__->mk_ro_accessors(
     qw( cache memcached_cache fastmmap_cache memory_cache ));
 
+our %L1_cache;
+
 =head2 get_instance
 
     my $cache = Koha::Cache->get_instance();
@@ -277,6 +279,10 @@ sub set_in_cache {
     my $expiry = $options->{expiry};
     $expiry //= $self->{timeout};
     my $set_sub = $self->{ref($self->{$cache}) . "_set"};
+
+    # Set in L1 cache
+    $L1_cache{ $key } = $value;
+
     # We consider an expiry of 0 to be inifinite
     if ( $expiry ) {
         return $set_sub
@@ -305,6 +311,10 @@ sub get_from_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
+    return $L1_cache{$key} if exists $L1_cache{$key};
+
     my $get_sub = $self->{ref($self->{$cache}) . "_get"};
     return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
 }
@@ -323,6 +333,10 @@ sub clear_from_cache {
     $cache ||= 'cache';
     croak "No key" unless $key;
     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
+
+    # Clear from L1 cache
+    delete $L1_cache{$key};
+
     return $self->{$cache}->delete($key)
       if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
     return $self->{$cache}->remove($key);
@@ -340,11 +354,19 @@ sub flush_all {
     my ( $self, $cache ) = shift;
     $cache ||= 'cache';
     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
+
+    $self->flush_L1_cache();
+
     return $self->{$cache}->flush_all()
       if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
     return $self->{$cache}->clear();
 }
 
+sub flush_L1_cache {
+    my( $self ) = @_;
+    %L1_cache = ();
+}
+
 =head1 TIED INTERFACE
 
 Koha::Cache also provides a tied interface which enables users to provide a

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;
-        C4::Context->clear_syspref_L1_cache();
+        Koha::Cache->flush_L1_cache();
         return $q;
     };
 }

misc/plack/koha.psgi

@@ -12,7 +12,7 @@ use CGI qw(-utf8 ); # we will lose -utf8 under plack
     *CGI::new = sub {
         my $q = $old_new->( @_ );
         $CGI::PARAM_UTF8 = 1;
-        C4::Context->clear_syspref_L1_cache();
+        Koha::Cache->flush_L1_cache();
         return $q;
     };
 }
@@ -45,6 +45,7 @@ use C4::XSLT;
 use C4::Branch;
 use C4::Category;
 use Koha::DateUtils;
+use Koha::Cache;
 =for preload
 use C4::Tags; # FIXME
 =cut