From d5d6daad1cc5ae1a9b0b41c6ed577dbcbf17df7a 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 Implements cache handlers for Memcached, mmap shared-file persistent, and in-process memory caches. If CHI is unavailable, Koha::Cache::Memcached will fall back to using Cache::Memcached::Fast, or caching will be skipped without croaking. To test: run t/Cache.t with the following options, before and after installing CHI: 2. Tests 3-9 should be skipped with the following: export CACHING_SYSTEM= 2. You should receive two failures with the following if CHI is not installed: export CACHING_SYSTEM=memory 3. You should receive two failures with the following if CHI is not installed: export CACHING_SYSTEM=fastmmap 4. You will need memcached activated for the following to work (but it will work both with and without CHI): 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 Signed-off-by: Chris Cormack Works as advertised, now we need a follow up to add the new dependency. http://bugs.koha-community.org/show_bug.cgi?id=8029 --- Koha/Cache.pm | 77 ++++++++++++++++++++++++++++++++----- Koha/Cache/Fastmmap.pm | 45 ++++++++++++++++++++++ Koha/Cache/Memcached.pm | 85 +++++++++++++++++++++++++++++++---------- Koha/Cache/Memory.pm | 46 ++++++++++++++++++++++ Koha/Cache/Null.pm | 41 ++++++++++++++++++++ t/Cache.t | 6 +-- 6 files changed, 266 insertions(+), 34 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 67064d4c09..636d73e6c3 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,25 +49,78 @@ B use strict; use warnings; use Carp; +use Module::Load::Conditional qw(can_load); +use Module::Load; -use base qw(Class::Accessor); +my $have_chi = 0; + +BEGIN: { + if ( can_load( modules => { CHI => undef } ) ) { + $have_chi = 1; + } +} -use Koha::Cache::Memcached; +use base qw(Class::Accessor); -__PACKAGE__->mk_ro_accessors( qw( cache ) ); +__PACKAGE__->mk_ro_accessors(qw( cache )); sub new { my $class = shift; my $param = shift; - my $cache_type = $ENV{CACHING_SYSTEM} || $param->{cache_type} || 'memcached'; - my $subclass = __PACKAGE__."::".ucfirst($cache_type); - my $cache = $subclass->_cache_handle($param) - or croak "Cannot create cache handle for '$cache_type'"; - return bless $class->SUPER::new({cache => $cache}), $subclass; + my $cache_type = + $ENV{CACHING_SYSTEM} + || $param->{cache_type} + || 'memcached'; + my $subclass = __PACKAGE__ . "::" . ucfirst($cache_type); + $param->{have_chi} = $have_chi; + unless ( can_load( modules => { $subclass => undef } ) ) { + $subclass = __PACKAGE__ . "::" . ucfirst('Null'); + load $subclass; + } + my $cache = $subclass->_cache_handle($param); + return + bless $class->SUPER::new( { cache => $cache, have_chi => $have_chi } ), + $subclass; } sub is_cache_active { - return $ENV{CACHING_SYSTEM} ? '1' : '' ; + 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"; + + return unless $self->{have_chi}; + + 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 unless $self->{have_chi}; + return $self->{cache}->get($key); +} + +sub clear_from_cache { + my ( $self, $key ) = @_; + croak "No key" unless $key; + return unless $self->{have_chi}; + return $self->{cache}->remove($key); +} + +sub flush_all { + my $self = shift; + return unless $self->{have_chi}; + return $self->{cache}->clear(); } =head2 EXPORT @@ -79,6 +135,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 0000000000..10c4eb0abc --- /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 226fa7c7e7..fe487259ef 100644 --- a/Koha/Cache/Memcached.pm +++ b/Koha/Cache/Memcached.pm @@ -1,6 +1,6 @@ package Koha::Cache::Memcached; -# Copyright 2009 Chris Cormack and The Koha Dev Team +# Copyright 2012 C & P Bibliography Services # # This file is part of Koha. # @@ -20,31 +20,63 @@ package Koha::Cache::Memcached; use strict; use warnings; use Carp; - -use Cache::Memcached; +use Cache::Memcached::Fast; +use Module::Load::Conditional qw(can_load); use base qw(Koha::Cache); sub _cache_handle { - my $class = shift; - 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, - namespace => $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha', - ); + my $class = shift; + my $params = shift; + my @servers = split /,/, + $params->{'cache_servers'} + ? $params->{'cache_servers'} + : $ENV{MEMCACHED_SERVERS}; + my $namespace = + $ENV{MEMCACHED_NAMESPACE} + || $params->{'namespace'} + || 'koha'; + $ENV{DEBUG} + && warn "Caching server settings: " + . join( ', ', @servers ) + . " with " + . ( $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha' ); + if ( + $params->{have_chi} + && can_load( + modules => + { 'CHI' => undef, 'CHI::Driver::Memcached::Fast' => undef } + ) + ) + { + return CHI->new( + driver => 'Memcached::Fast', + servers => \@servers, + namespace => $namespace, + compress_threshold => 10_000, + l1_cache => + { driver => 'Memory', global => 1, max_size => 1024 * 1024 }, + ); + + # We use a 1MB L1 memory cache for added efficiency + } + else { + return Cache::Memcached::Fast->new( + { + servers => \@servers, + compress_threshold => 10_000, + namespace => $namespace, + } + ); + } } 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"; + return $self->SUPER::set_in_cache( $key, $value, $expiry ) + if ( $self->{have_chi} ); + # No CHI, we have to use Cache::Memcached::Fast directly if ( defined $expiry ) { return $self->cache->set( $key, $value, $expiry ); } @@ -55,20 +87,31 @@ sub set_in_cache { sub get_from_cache { my ( $self, $key ) = @_; - croak "No key" unless $key; - $ENV{DEBUG} && warn "get_from_cache for Memcache $key"; + return $self->SUPER::get_from_cache($key) if ( $self->{have_chi} ); + + # No CHI, we have to use Cache::Memcached::Fast directly return $self->cache->get($key); } sub clear_from_cache { my ( $self, $key ) = @_; - croak "No key" unless $key; + return $self->SUPER::clear_from_cache($key) if ( $self->{have_chi} ); + + # No CHI, we have to use Cache::Memcached::Fast directly 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; + if ( $self->{have_chi} ) { + $self->{cache}->l1_cache->clear(); + return $self->{cache}->memd->flush_all(); + } + else { + return $self->{cache}->flush_all; + } } 1; diff --git a/Koha/Cache/Memory.pm b/Koha/Cache/Memory.pm new file mode 100644 index 0000000000..daeeb4a1e3 --- /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 0000000000..bde6509f92 --- /dev/null +++ b/Koha/Cache/Null.pm @@ -0,0 +1,41 @@ +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 Module::Load; + +use base qw(Koha::Cache); + +sub _cache_handle { + my $class = shift; + my $params = shift; + load CHI if $params->{have_chi}; + return $params->{have_chi} ? CHI->new( driver => 'Null' ) : undef; +} + +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 286c0c9c92..d595dc98c9 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"); -- 2.39.5