Bug 8092: Convert Koha::Cache to use CHI
[koha.git] / Koha / Cache / Memcached.pm
1 package Koha::Cache::Memcached;
2
3 # Copyright 2012 C & P Bibliography Services
4 #
5 # This file is part of Koha.
6 #
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
10 # version.
11 #
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.
15 #
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.
19
20 use strict;
21 use warnings;
22 use Carp;
23 use Cache::Memcached::Fast;
24 use Module::Load::Conditional qw(can_load);
25
26 use base qw(Koha::Cache);
27
28 sub _cache_handle {
29     my $class   = shift;
30     my $params  = shift;
31     my @servers = split /,/,
32       $params->{'cache_servers'}
33       ? $params->{'cache_servers'}
34       : $ENV{MEMCACHED_SERVERS};
35     my $namespace =
36          $ENV{MEMCACHED_NAMESPACE}
37       || $params->{'namespace'}
38       || 'koha';
39     $ENV{DEBUG}
40       && warn "Caching server settings: "
41       . join( ', ', @servers )
42       . " with "
43       . ( $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha' );
44     if (
45         $params->{have_chi}
46         && can_load(
47             modules =>
48               { 'CHI' => undef, 'CHI::Driver::Memcached::Fast' => undef }
49         )
50       )
51     {
52         return CHI->new(
53             driver             => 'Memcached::Fast',
54             servers            => \@servers,
55             namespace          => $namespace,
56             compress_threshold => 10_000,
57             l1_cache =>
58               { driver => 'Memory', global => 1, max_size => 1024 * 1024 },
59         );
60
61         # We use a 1MB L1 memory cache for added efficiency
62     }
63     else {
64         return Cache::Memcached::Fast->new(
65             {
66                 servers            => \@servers,
67                 compress_threshold => 10_000,
68                 namespace          => $namespace,
69             }
70         );
71     }
72 }
73
74 sub set_in_cache {
75     my ( $self, $key, $value, $expiry ) = @_;
76     return $self->SUPER::set_in_cache( $key, $value, $expiry )
77       if ( $self->{have_chi} );
78
79     # No CHI, we have to use Cache::Memcached::Fast directly
80     if ( defined $expiry ) {
81         return $self->cache->set( $key, $value, $expiry );
82     }
83     else {
84         return $self->cache->set( $key, $value );
85     }
86 }
87
88 sub get_from_cache {
89     my ( $self, $key ) = @_;
90     return $self->SUPER::get_from_cache($key) if ( $self->{have_chi} );
91
92     # No CHI, we have to use Cache::Memcached::Fast directly
93     return $self->cache->get($key);
94 }
95
96 sub clear_from_cache {
97     my ( $self, $key ) = @_;
98     return $self->SUPER::clear_from_cache($key) if ( $self->{have_chi} );
99
100     # No CHI, we have to use Cache::Memcached::Fast directly
101     return $self->cache->delete($key);
102 }
103
104 # We have to overload flush_all because CHI::Driver::Memcached::Fast does not
105 # support the clear() method
106 sub flush_all {
107     my $self = shift;
108     if ( $self->{have_chi} ) {
109         $self->{cache}->l1_cache->clear();
110         return $self->{cache}->memd->flush_all();
111     }
112     else {
113         return $self->{cache}->flush_all;
114     }
115 }
116
117 1;
118 __END__
119
120 =head1 NAME
121
122 Koha::Cache::Memcached - memcached subclass of Koha::Cache
123
124 =cut