Attachment 26909 Details for Bug 12041 – Bug 12041 - improve Koha::Cache

[patch] Bug 12041 - improve Koha::Cache

Bug-12041---improve-KohaCache.patch (text/plain), 16.44 KB, created by Robin Sheat on 2014-04-09 02:49:18 UTC

(hide)

Description:

Filename:

MIME Type:

Creator: Robin Sheat

Created: 2014-04-09 02:49:18 UTC

Size: 16.44 KB

patch

obsolete

>From 24530b8353967eeaba53de43766d0e86aa5ee116 Mon Sep 17 00:00:00 2001
>From: Robin Sheat <robin@catalyst.net.nz>
>Date: Tue, 8 Apr 2014 17:51:01 +1200
>Subject: [PATCH] Bug 12041 - improve Koha::Cache
>
>This makes Koha::Cache behave better by default. It will use memcached
>if available to do shared caching, if that's not available it will fall
>back to in-memory caching. It also allows for a singleton accessor to
>allow a single cache to be shared within a process.
>
>Added tests to confirm UTF8-cleanness.
>
>Test plan:
>* The t/Cache.t file runs successfully with and without the
>  MEMCACHED_SERVERS envvar set (and memcached running in the
>  environment.)
>---
> C4/External/OverDrive.pm      |   6 +-
> Koha/Cache.pm                 | 148 +++++++++++++++++++++++++++++++++---------
> Koha/Cache/Object.pm          |  17 ++---
> Koha/Template/Plugin/Cache.pm |   5 +-
> opac/svc/report               |   9 +--
> svc/report                    |   6 +-
> t/Cache.t                     |  24 +++++--
> 7 files changed, 158 insertions(+), 57 deletions(-)
>
>diff --git a/C4/External/OverDrive.pm b/C4/External/OverDrive.pm
>index 4d56965..bed0d55 100644
>--- a/C4/External/OverDrive.pm
>+++ b/C4/External/OverDrive.pm
>@@ -99,7 +99,7 @@ sub GetOverDriveToken {
> 
>     my $cache;
> 
>-    eval { $cache = Koha::Cache->new() };
>+    eval { $cache = Koha::Cache->get_instance() };
> 
>     my $token;
>     $cache and $token = $cache->get_from_cache( "overdrive_token" ) and return $token;
>@@ -124,7 +124,9 @@ sub GetOverDriveToken {
>     $token = $contents->{'token_type'} . ' ' . $contents->{'access_token'};
> 
>     # Fudge factor to prevent spurious failures
>-    $cache and $cache->set_in_cache( 'overdrive_token', $token, $contents->{'expires_in'} - 5 );
>+    $cache
>+      and $cache->set_in_cache( 'overdrive_token', $token,
>+        { expiry => $contents->{'expires_in'} - 5 } );
> 
>     return $token;
> }
>diff --git a/Koha/Cache.pm b/Koha/Cache.pm
>index e119bda..c29d416 100644
>--- a/Koha/Cache.pm
>+++ b/Koha/Cache.pm
>@@ -30,12 +30,11 @@ Koha::Cache - Handling caching of html and Objects for Koha
> =head1 DESCRIPTION
> 
> Koha caching routines. This class provides two interfaces for cache access.
>-The first, traditional interface provides the following functions:
>+The first, traditional OO interface provides the following functions:
> 
> =head1 FUNCTIONS
> 
> =cut
>-
> use strict;
> use warnings;
> use Carp;
>@@ -47,6 +46,23 @@ use base qw(Class::Accessor);
> __PACKAGE__->mk_ro_accessors(
>     qw( cache memcached_cache fastmmap_cache memory_cache ));
> 
>+=head2 get_instance
>+
>+    my $cache = Koha::Cache->get_instance();
>+
>+This gets a shared instance of the cache, set up in a very default way. This is
>+the recommended way to fetch a cache object. If possible, it'll be
>+persistent across multiple instances.
>+
>+=cut
>+
>+our $singleton_cache;
>+sub get_instance {
>+    my ($class) = @_;
>+    $singleton_cache = $class->new() unless $singleton_cache;
>+    return $singleton_cache;
>+}
>+
> =head2 new
> 
> Create a new Koha::Cache object. This is required for all cache-related functionality.
>@@ -92,15 +108,19 @@ sub new {
>         }
>     }
> 
>-# NOTE: The following five lines could be uncommented if we wanted to
>-#       fall back to any functioning cache. Commented out since this would
>-#       represent a change in behavior.
>-#
>-#unless (defined($self->{'cache'})) {
>-#    foreach my $cachemember (qw(memory_cache fastmmap_cache memcached_cache)) {
>-#        $self->{'cache'} = $self->{$cachemember} if (defined($self->{$cachemember}));
>-#    }
>-#}
>+    # Unless a default has already been picked, we go through in best-to-
>+    # least-best order, looking for something we can use. fastmmap_cache
>+    # is excluded because it doesn't support expiry in a useful way.
>+    unless ( defined( $self->{'cache'} ) ) {
>+        foreach my $cachemember (qw(memcached_cache memory_cache )) {
>+            if ( defined( $self->{$cachemember} ) ) {
>+                $self->{'cache'} = $self->{$cachemember};
>+                last;
>+            }
>+        }
>+    }
>+
>+    $ENV{DEBUG} && carp "Selected caching system: " . ($self->{'cache'} // 'none');
> 
>     return
>       bless $self,
>@@ -119,13 +139,21 @@ sub _initialize_memcached {
>       . join( ', ', @servers )
>       . " with "
>       . $self->{'namespace'};
>-    $self->{'memcached_cache'} = Cache::Memcached::Fast->new(
>+    # Cache::Memcached::Fast doesn't allow a default expire time to be set
>+    # so we force it on setting.
>+    my $memcached = Cache::Memcached::Fast->new(
>         {
>             servers            => \@servers,
>             compress_threshold => 10_000,
>             namespace          => $self->{'namespace'},
>+            debug              => 0,
>+            utf8               => 1,
>         }
>     );
>+    # Ensure we can actually talk to the memcached server
>+    my $ismemcached = $memcached->set('ismemcached','1');
>+    return $self unless $ismemcached;
>+    $self->{'memcached_cache'} = $memcached;
>     return $self;
> }
> 
>@@ -143,48 +171,103 @@ sub _initialize_fastmmap {
> sub _initialize_memory {
>     my ($self) = @_;
> 
>-    $self->{'memory_cache'} = Cache::Memory->new(
>+    # Default cache time for memory is _always_ short unless it's specially
>+    # defined, to allow it to work reliably in a persistent environment.
>+    my $cache = Cache::Memory->new(
>         'namespace'       => $self->{'namespace'},
>-        'default_expires' => $self->{'timeout'}
>+        'default_expires' => "$self->{'timeout'} sec" || "10 sec",
>     );
>+    $self->{'memory_cache'} = $cache;
>+    # Memory cache can't handle complex types for some reason, so we use its
>+    # freeze and thaw functions.
>+    $self->{ref($cache) . '_set'} = sub {
>+        my ($key, $val, $exp) = @_;
>+        # Refer to set_expiry in Cache::Entry for why we do this 'sec' thing.
>+        $exp = "$exp sec" if defined $exp;
>+        # Because we need to use freeze, it must be a reference type.
>+        $cache->freeze($key, [$val], $exp);
>+    };
>+    $self->{ref($cache) . '_get'} = sub {
>+        my $res = $cache->thaw(shift);
>+        return unless defined $res;
>+        return $res->[0];
>+    };
>     return $self;
> }
> 
> =head2 is_cache_active
> 
>-Routine that checks whether or not a caching system has been selected. This is
>-not an instance method.
>+Routine that checks whether or not a default caching method is active on this
>+object.
> 
> =cut
> 
> sub is_cache_active {
>-    return $ENV{CACHING_SYSTEM} ? '1' : '';
>+    my $self = shift;
>+    return $self->{'cache'} ? 1 : 0;
> }
> 
> =head2 set_in_cache
> 
>-    $cache->set_in_cache($key, $value, [$expiry]);
>+    $cache->set_in_cache($key, $value, [$options]);
>+
>+Save a value to the specified key in the cache. A hashref of options may be
>+specified.
> 
>-Save a value to the specified key in the default cache, optionally with a
>-particular expiry.
>+The possible options are:
>+
>+=over
>+
>+=item expiry
>+
>+Expiry time of this cached entry in seconds.
>+
>+=item deepcopy
>+
>+If set, this will perform a deep copy of the item when it's retrieved. This
>+means that it'll be safe if something later modifies the result of the
>+function. Will be ignored in situations where the same behaviour comes from
>+the caching layer anyway.
>+
>+=item cache
>+
>+The cache object to use if you want to provide your own. It should be an
>+instance of C<Cache::*> and follow the same interface as L<Cache::Memcache>.
> 
> =cut
> 
> sub set_in_cache {
>-    my ( $self, $key, $value, $expiry, $cache ) = @_;
>-    $cache ||= 'cache';
>+    my ( $self, $key, $value, $options, $_cache) = @_;
>+    # This is a bit of a hack to support the old API in case things still use it
>+    if (defined $options && (ref($options) ne 'HASH')) {
>+        my $new_options;
>+        $new_options->{expiry} = $options;
>+        $new_options->{cache} = $_cache if defined $_cache;
>+        $options = $new_options;
>+    }
>+
>+    # the key mustn't contain whitespace (or control characters) for memcache
>+    # but shouldn't be any harm in applying it globally.
>+    $key =~ s/[\x00-\x20]/_/g;
>+
>+    my $cache = $options->{cache} || 'cache';
>     croak "No key" unless $key;
>     $ENV{DEBUG} && carp "set_in_cache for $key";
> 
>     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
>-    if ( defined $expiry ) {
>-        if ( ref( $self->{$cache} ) eq 'Cache::Memory' ) {
>-            $expiry = "$expiry sec";
>-        }
>-        return $self->{$cache}->set( $key, $value, $expiry );
>+    my $expiry = $options->{expiry};
>+    $expiry //= $self->{timeout};
>+    my $set_sub = $self->{ref($self->{$cache}) . "_set"};
>+    # We consider an expiry of 0 to be inifinite
>+    if ( $expiry ) {
>+        return $set_sub
>+          ? $set_sub->( $key, $value, $expiry )
>+          : $self->{$cache}->set( $key, $value, $expiry );
>     }
>     else {
>-        return $self->{$cache}->set( $key, $value );
>+        return $set_sub
>+          ? $set_sub->( $key, $value )
>+          : $self->{$cache}->set( $key, $value );
>     }
> }
> 
>@@ -198,11 +281,13 @@ Retrieve the value stored under the specified key in the default cache.
> 
> sub get_from_cache {
>     my ( $self, $key, $cache ) = @_;
>+    $key =~ s/[\x00-\x20]/_/g;
>     $cache ||= 'cache';
>     croak "No key" unless $key;
>     $ENV{DEBUG} && carp "get_from_cache for $key";
>     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
>-    return $self->{$cache}->get($key);
>+    my $get_sub = $self->{ref($self->{$cache}) . "_get"};
>+    return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key);
> }
> 
> =head2 clear_from_cache
>@@ -215,11 +300,12 @@ Remove the value identified by the specified key from the default cache.
> 
> sub clear_from_cache {
>     my ( $self, $key, $cache ) = @_;
>+    $key =~ s/[\x00-\x20]/_/g;
>     $cache ||= 'cache';
>     croak "No key" unless $key;
>     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
>     return $self->{$cache}->delete($key)
>-      if ( ref( $self->{$cache} ) eq 'Cache::Memcached::Fast' );
>+      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
>     return $self->{$cache}->remove($key);
> }
> 
>@@ -236,7 +322,7 @@ sub flush_all {
>     $cache ||= 'cache';
>     return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ );
>     return $self->{$cache}->flush_all()
>-      if ( ref( $self->{$cache} ) eq 'Cache::Memcached::Fast' );
>+      if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' );
>     return $self->{$cache}->clear();
> }
> 
>diff --git a/Koha/Cache/Object.pm b/Koha/Cache/Object.pm
>index f201e95..b5f947c 100644
>--- a/Koha/Cache/Object.pm
>+++ b/Koha/Cache/Object.pm
>@@ -71,7 +71,7 @@ sub TIESCALAR {
>         $self->{'value'} = &{ $self->{'preload'} }( @{ $self->{'arguments'} } );
>         if ( defined( $self->{'cache'} ) ) {
>             $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
>-                $self->{'timeout'}, $self->{'cache_type'} . '_cache' );
>+                { expiry => $self->{'timeout'} } );
>         }
>         $self->{'lastupdate'} = time;
>     }
>@@ -90,9 +90,7 @@ sub FETCH {
>     if ( !( $self->{'inprocess'} && defined( $self->{'value'} ) )
>         && $self->{'cache'} )
>     {
>-        $self->{'value'} =
>-          $self->{'cache'}
>-          ->get_from_cache( $self->{'key'}, $self->{'cache_type'} . '_cache' );
>+        $self->{'value'} = $self->{'cache'}->get_from_cache( $self->{'key'} );
>         $self->{'lastupdate'} = $now;
>     }
> 
>@@ -106,7 +104,7 @@ sub FETCH {
>             $self->{'value'}, $index );
>         if ( defined( $self->{'cache'} ) ) {
>             $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
>-                $self->{'timeout'}, $self->{'cache_type'} . '_cache' );
>+                { expiry => $self->{'timeout'} } );
>         }
>         $self->{'lastupdate'} = $now;
>     }
>@@ -130,9 +128,9 @@ sub STORE {
>         && $self->{'allowupdate'}
>         && defined( $self->{'cache'} ) )
>     {
>-        $self->{'cache'}
>-          ->set_in_cache( $self->{'key'}, $self->{'value'}, $self->{'timeout'},
>-            $self->{'cache_type'} . '_cache' );
>+        $self->{'cache'}->set_in_cache( $self->{'key'}, $self->{'value'},
>+            { expiry => $self->{'timeout'} },
>+        );
>     }
> 
>     return $self->{'value'};
>@@ -149,8 +147,7 @@ sub DESTROY {
>         && $self->{'unset'}
>         && defined( $self->{'cache'} ) )
>     {
>-        $self->{'cache'}->clear_from_cache( $self->{'key'},
>-            $self->{'cache_type'} . '_cache' );
>+        $self->{'cache'}->clear_from_cache( $self->{'key'} );
>     }
> 
>     undef $self->{'value'};
>diff --git a/Koha/Template/Plugin/Cache.pm b/Koha/Template/Plugin/Cache.pm
>index fb3a76a..3b8f96c 100644
>--- a/Koha/Template/Plugin/Cache.pm
>+++ b/Koha/Template/Plugin/Cache.pm
>@@ -37,7 +37,7 @@ sub new {
>     }
>     else {
>         require Koha::Cache;
>-        $cache = Koha::Cache->new( { 'cache_type' => 'memcached', 'cache_servers' => C4::Context->config('memcached_servers') });
>+        $cache = Koha::Cache->get_instance();
>     }
>     my $self = bless {
>         CACHE   => $cache,
>@@ -84,7 +84,8 @@ sub _cached_action {
>     my $result = $self->{CACHE}->get_from_cache($key);
>     if ( !$result ) {
>         $result = $self->{CONTEXT}->$action( $params->{template} );
>-        $self->{CACHE}->set_in_cache( $key, $result, $params->{ttl} );
>+        $self->{CACHE}
>+          ->set_in_cache( $key, $result, { expiry => $params->{ttl} } );
>     }
>     return $result;
> }
>diff --git a/opac/svc/report b/opac/svc/report
>index 57ca797..3c93af0 100755
>--- a/opac/svc/report
>+++ b/opac/svc/report
>@@ -36,11 +36,11 @@ if (!$report_rec) { die "There is no such report.\n"; }
> 
> die "Sorry this report is not public\n" unless $report_rec->{public};
> 
>-my $cache_active = Koha::Cache->is_cache_active;
>-my ($cache_key, $cache, $json_text);
>+my $cache = Koha::Cache->get_instance();
>+my $cache_active = $cache->is_cache_active;
>+my ($cache_key, $json_text);
> if ($cache_active) {
>     $cache_key = "opac:report:".($report_name ? "name:$report_name" : "id:$report_id");
>-    $cache = Koha::Cache->new();
>     $json_text = $cache->get_from_cache($cache_key);
> }
> 
>@@ -59,7 +59,8 @@ unless ($json_text) {
>         $json_text = to_json($lines);
> 
>         if ($cache_active) {
>-            $cache->set_in_cache( $cache_key, $json_text, $report_rec->{cache_expiry} );
>+            $cache->set_in_cache( $cache_key, $json_text,
>+                { expiry => $report_rec->{cache_expiry} } );
>         }
>     }
>     else {
>diff --git a/svc/report b/svc/report
>index 0cff7dc..501cac9 100755
>--- a/svc/report
>+++ b/svc/report
>@@ -46,11 +46,11 @@ my ( $template, $loggedinuser, $cookie ) = get_template_and_user(
>     }
> );
> 
>-my $cache_active = Koha::Cache->is_cache_active;
>-my ($cache_key, $cache, $json_text);
>+my $cache = Koha::Cache->get_instance();
>+my $cache_active = $cache->is_cache_active;
>+my ($cache_key, $json_text);
> if ($cache_active) {
>     $cache_key = "intranet:report:".($report_name ? "name:$report_name" : "id:$report_id");
>-    $cache = Koha::Cache->new();
>     $json_text = $cache->get_from_cache($cache_key);
> }
> 
>diff --git a/t/Cache.t b/t/Cache.t
>index 044206c..65cf52b 100644
>--- a/t/Cache.t
>+++ b/t/Cache.t
>@@ -5,7 +5,7 @@
> use strict;
> use warnings;
> 
>-use Test::More tests => 29;
>+use Test::More tests => 32;
> 
> my $destructorcount = 0;
> 
>@@ -16,10 +16,10 @@ BEGIN {
> }
> 
> SKIP: {
>-    my $cache = Koha::Cache->new();
>+    my $cache = Koha::Cache->get_instance();
> 
>-    skip "Cache not enabled", 25
>-      unless ( Koha::Cache->is_cache_active() && defined $cache );
>+    skip "Cache not enabled", 28
>+      unless ( $cache->is_cache_active() && defined $cache );
> 
>     # test fetching an item that isnt in the cache
>     is( $cache->get_from_cache("not in here"),
>@@ -134,12 +134,26 @@ SKIP: {
> 
>     $hash{'key'} = 'value';
>     is($myhash->{'key'}, 'value', 'retrieved value after clearing cache');
>+
>+    # UTF8 testing
>+    my $utf8_str = "A MÃ¸Ã¸se once bit my sister";
>+    $cache->set_in_cache('utf8_1', $utf8_str);
>+    is($cache->get_from_cache('utf8_1'), $utf8_str, 'Simple 8-bit UTF8 correctly retrieved');
>+    $utf8_str = "\x{20ac}"; # â¬
>+    $cache->set_in_cache('utf8_1', $utf8_str);
>+    my $utf8_res = $cache->get_from_cache('utf8_1');
>+    # This'll ensure that we're getting a unicode string back, rather than
>+    # a couple of bytes.
>+    is(length($utf8_res), 1, 'UTF8 string length correct');
>+    # ...and that it's really the character we intend
>+    is(ord($utf8_res), 8364, 'UTF8 string value correct');
> }
> 
> END {
>   SKIP: {
>+        my $cache = Koha::Cache->get_instance();
>         skip "Cache not enabled", 1
>-          unless ( Koha::Cache->is_cache_active() );
>+          unless ( $cache->is_cache_active() );
>         is( $destructorcount, 1, 'Destructor run exactly once' );
>     }
> }
>-- 
>1.8.3.2

Actions: View | Diff | Splinter Review

Attachments on bug 12041: 26891 | 26908 | 26909 | 26949 | 27381 | 28415 | 28611 | 28612 | 28613