1 package Koha::Cache::Memcached;
3 # Copyright 2012 C & P Bibliography Services
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it under the
8 # terms of the GNU General Public License as published by the Free Software
9 # Foundation; either version 2 of the License, or (at your option) any later
12 # Koha is distributed in the hope that it will be useful, but WITHOUT ANY
13 # WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
14 # A PARTICULAR PURPOSE. See the GNU General Public License for more details.
16 # You should have received a copy of the GNU General Public License along
17 # with Koha; if not, write to the Free Software Foundation, Inc.,
18 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
23 use Cache::Memcached::Fast;
24 use Module::Load::Conditional qw(can_load);
26 use base qw(Koha::Cache);
31 my @servers = split /,/,
32 $params->{'cache_servers'}
33 ? $params->{'cache_servers'}
34 : $ENV{MEMCACHED_SERVERS};
36 $ENV{MEMCACHED_NAMESPACE}
37 || $params->{'namespace'}
40 && warn "Caching server settings: "
41 . join( ', ', @servers )
43 . ( $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha' );
48 { 'CHI' => undef, 'CHI::Driver::Memcached::Fast' => undef }
53 driver => 'Memcached::Fast',
55 namespace => $namespace,
56 compress_threshold => 10_000,
58 { driver => 'Memory', global => 1, max_size => 1024 * 1024 },
61 # We use a 1MB L1 memory cache for added efficiency
64 return Cache::Memcached::Fast->new(
67 compress_threshold => 10_000,
68 namespace => $namespace,
75 my ( $self, $key, $value, $expiry ) = @_;
76 return $self->SUPER::set_in_cache( $key, $value, $expiry )
77 if ( $self->{have_chi} );
79 # No CHI, we have to use Cache::Memcached::Fast directly
80 if ( defined $expiry ) {
81 return $self->cache->set( $key, $value, $expiry );
84 return $self->cache->set( $key, $value );
89 my ( $self, $key ) = @_;
90 return $self->SUPER::get_from_cache($key) if ( $self->{have_chi} );
92 # No CHI, we have to use Cache::Memcached::Fast directly
93 return $self->cache->get($key);
96 sub clear_from_cache {
97 my ( $self, $key ) = @_;
98 return $self->SUPER::clear_from_cache($key) if ( $self->{have_chi} );
100 # No CHI, we have to use Cache::Memcached::Fast directly
101 return $self->cache->delete($key);
104 # We have to overload flush_all because CHI::Driver::Memcached::Fast does not
105 # support the clear() method
108 if ( $self->{have_chi} ) {
109 $self->{cache}->l1_cache->clear();
110 return $self->{cache}->memd->flush_all();
113 return $self->{cache}->flush_all;
122 Koha::Cache::Memcached - memcached subclass of Koha::Cache