From 53390a25d9f7be5d70c0e16d377fec809ba47968 Mon Sep 17 00:00:00 2001 From: Jared Camins-Esakov Date: Tue, 15 May 2012 13:03:30 -0400 Subject: [PATCH] Bug 8092: Convert Koha::Cache to use CHI Content-Type: text/plain; charset="UTF-8" Implements cache handlers for Memcached, mmap shared-file persistent, and in-process memory caches. To test: run t/Cache.t with the following options: 1. Tests 3-9 should be skipped with the following: export CACHING_SYSTEM= 2. export CACHING_SYSTEM=memory 3. export CACHING_SYSTEM=fastmmap 4. You will need memcached activated for the following to work: export CACHING_SYSTEM=memcached export MEMCACHED_SERVERS=127.0.0.1:11211 export MEMCACHED_NAMESPACE=KOHA 5. You should receive two failures with the following: export CACHING_SYSTEM=thisdoesntexist --- Koha/Cache.pm | 46 +++++++++++++++++++++++++++++++++++++++++++--- Koha/Cache/Fastmmap.pm | 45 +++++++++++++++++++++++++++++++++++++++++++++ Koha/Cache/Memcached.pm | 47 ++++++++++++----------------------------------- Koha/Cache/Memory.pm | 46 ++++++++++++++++++++++++++++++++++++++++++++++ Koha/Cache/Null.pm | 42 ++++++++++++++++++++++++++++++++++++++++++ t/Cache.t | 6 +++--- 6 files changed, 191 insertions(+), 41 deletions(-) create mode 100644 Koha/Cache/Fastmmap.pm create mode 100644 Koha/Cache/Memory.pm create mode 100644 Koha/Cache/Null.pm diff --git a/Koha/Cache.pm b/Koha/Cache.pm index 67064d4..fa6a9a6 100644 --- a/Koha/Cache.pm +++ b/Koha/Cache.pm @@ -27,10 +27,13 @@ Koha::Cache - Handling caching of html and Objects for Koha =head1 DESCRIPTION -Base class for Koha::Cache::X. Subclasses need to provide the following methods +Base class for Koha::Cache::X. Subclasses must provide the following methods B<_cache_handle ($params_hr)> - cache handle creator +Subclasses may override the following methods if they are not using a +CHI-derived cache + B B @@ -46,11 +49,12 @@ B use strict; use warnings; use Carp; +use Module::Load::Conditional qw(can_load); +use Module::Load; +use CHI; use base qw(Class::Accessor); -use Koha::Cache::Memcached; - __PACKAGE__->mk_ro_accessors( qw( cache ) ); sub new { @@ -58,6 +62,10 @@ sub new { my $param = shift; my $cache_type = $ENV{CACHING_SYSTEM} || $param->{cache_type} || 'memcached'; my $subclass = __PACKAGE__."::".ucfirst($cache_type); + unless (can_load( modules => { $subclass => 0 }) ) { + $subclass = __PACKAGE__."::".ucfirst('Null'); + load $subclass; + } my $cache = $subclass->_cache_handle($param) or croak "Cannot create cache handle for '$cache_type'"; return bless $class->SUPER::new({cache => $cache}), $subclass; @@ -67,6 +75,37 @@ sub is_cache_active { return $ENV{CACHING_SYSTEM} ? '1' : '' ; } +sub set_in_cache { + my ( $self, $key, $value, $expiry ) = @_; + croak "No key" unless $key; + $ENV{DEBUG} && warn "set_in_cache for $key"; + + if ( defined $expiry ) { + return $self->{cache}->set( $key, $value, $expiry ); + } + else { + return $self->{cache}->set( $key, $value ); + } +} + +sub get_from_cache { + my ( $self, $key ) = @_; + croak "No key" unless $key; + $ENV{DEBUG} && warn "get_from_cache for $key"; + return $self->{cache}->get($key); +} + +sub clear_from_cache { + my ( $self, $key ) = @_; + croak "No key" unless $key; + return $self->{cache}->remove($key); +} + +sub flush_all { + my $self = shift; + return $self->{cache}->clear(); +} + =head2 EXPORT None by default. @@ -79,6 +118,7 @@ Koha::Cache::Memcached Chris Cormack, Echris@bigballofwax.co.nzE Paul Poulain, Epaul.poulain@biblibre.comE +Jared Camins-Esakov, Ejcamins@cpbibliography.comE =cut diff --git a/Koha/Cache/Fastmmap.pm b/Koha/Cache/Fastmmap.pm new file mode 100644 index 0000000..f2898f6 --- /dev/null +++ b/Koha/Cache/Fastmmap.pm @@ -0,0 +1,45 @@ +package Koha::Cache::Fastmmap; + +# Copyright 2012 C & P Bibliography Services +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use Carp; +use CHI; + +use base qw(Koha::Cache); + +sub _cache_handle { + my $class = shift; + my $params = shift; + return CHI->new( + driver => 'FastMmap', + namespace => $params->{'namespace'} || 'koha', + expire_in => 600, + cache_size => $params->{'cachesize'} || '1m', + ); +} + +1; +__END__ + +=head1 NAME + +Koha::Cache::Fastmmap - persistent interprocess mmap-based cache for Koha + +=cut diff --git a/Koha/Cache/Memcached.pm b/Koha/Cache/Memcached.pm index 226fa7c..8b6203b 100644 --- a/Koha/Cache/Memcached.pm +++ b/Koha/Cache/Memcached.pm @@ -20,8 +20,8 @@ package Koha::Cache::Memcached; use strict; use warnings; use Carp; - -use Cache::Memcached; +use CHI; +use Cache::Memcached::Fast; use base qw(Koha::Cache); @@ -30,45 +30,22 @@ sub _cache_handle { my $params = shift; my @servers = split /,/, $params->{'cache_servers'}?$params->{'cache_servers'}:$ENV{MEMCACHED_SERVERS}; $ENV{DEBUG} && warn "Caching server settings: ".join(', ',@servers)." with ".($ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha'); - return Cache::Memcached->new( - servers => \@servers, - debug => 0, - compress_threshold => 10_000, - expire_time => 600, + return CHI->new( + driver => 'Memcached::Fast', + servers => \@servers, namespace => $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha', + compress_threshold => 10_000, + l1_cache => { driver => 'Memory', global => 1, max_size => 1024*1024 }, ); + # We use a 1MB L1 memory cache for added efficiency } -sub set_in_cache { - my ( $self, $key, $value, $expiry ) = @_; - croak "No key" unless $key; - $self->cache->set_debug; - $ENV{DEBUG} && warn "set_in_cache for Memcache $key"; - - if ( defined $expiry ) { - return $self->cache->set( $key, $value, $expiry ); - } - else { - return $self->cache->set( $key, $value ); - } -} - -sub get_from_cache { - my ( $self, $key ) = @_; - croak "No key" unless $key; - $ENV{DEBUG} && warn "get_from_cache for Memcache $key"; - return $self->cache->get($key); -} - -sub clear_from_cache { - my ( $self, $key ) = @_; - croak "No key" unless $key; - return $self->cache->delete($key); -} - +# We have to overload flush_all because CHI::Driver::Memcached::Fast does not +# support the clear() method sub flush_all { my $self = shift; - return $self->cache->flush_all; + $self->{cache}->l1_cache->clear(); + return $self->{cache}->memd->flush_all(); } 1; diff --git a/Koha/Cache/Memory.pm b/Koha/Cache/Memory.pm new file mode 100644 index 0000000..f9062fd --- /dev/null +++ b/Koha/Cache/Memory.pm @@ -0,0 +1,46 @@ +package Koha::Cache::Memory; + +# Copyright 2012 C & P Bibliography Services +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use Carp; +use CHI; + +use base qw(Koha::Cache); + +sub _cache_handle { + my $class = shift; + my $params = shift; + return CHI->new( + driver => 'Memory', + namespace => $params->{'namespace'} || 'koha', + expire_in => 600, + max_size => $params->{'max_size'} || 8192*1024, + global => 1, + ); +} + +1; +__END__ + +=head1 NAME + +Koha::Cache::Memory - in-process memory based cache for Koha + +=cut diff --git a/Koha/Cache/Null.pm b/Koha/Cache/Null.pm new file mode 100644 index 0000000..59064d3 --- /dev/null +++ b/Koha/Cache/Null.pm @@ -0,0 +1,42 @@ +package Koha::Cache::Null; + +# Copyright 2012 C & P Bibliography Services +# +# This file is part of Koha. +# +# Koha is free software; you can redistribute it and/or modify it under the +# terms of the GNU General Public License as published by the Free Software +# Foundation; either version 2 of the License, or (at your option) any later +# version. +# +# Koha is distributed in the hope that it will be useful, but WITHOUT ANY +# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR +# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License along +# with Koha; if not, write to the Free Software Foundation, Inc., +# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. + +use strict; +use warnings; +use Carp; +use CHI; + +use base qw(Koha::Cache); + +sub _cache_handle { + my $class = shift; + my $params = shift; + return CHI->new( + driver => 'Null', + ); +} + +1; +__END__ + +=head1 NAME + +Koha::Cache::Null - null (no-op) cache for Koha + +=cut diff --git a/t/Cache.t b/t/Cache.t index 286c0c9..d595dc9 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -1,6 +1,6 @@ #!/usr/bin/perl -# Tests Koha::Cache and Koha::Cache::Memcached (through Koha::Cache) +# Tests Koha::Cache and whichever type of cache is enabled (through Koha::Cache) use strict; use warnings; @@ -13,9 +13,9 @@ BEGIN { } SKIP: { - skip "Memcached not enabled", 7 unless C4::Context->ismemcached; + my $cache = Koha::Cache->new (); - my $cache = Koha::Cache->new ( { 'cache_servers' => $ENV{'MEMCACHED_SERVERS'} } ); + skip "Cache not enabled", 7 unless (Koha::Cache->is_cache_active() && defined $cache); # test fetching an item that isnt in the cache is( $cache->get_from_cache("not in here"), undef, "fetching item NOT in cache"); -- 1.7.2.5