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