Bug 8092: Convert Koha::Cache to use CHI

[koha-ffzg.git] / Koha / Cache / Memcached.pm

diff --git a/Koha/Cache/Memcached.pm b/Koha/Cache/Memcached.pm
index 87fe3c7..fe48725 100644 (file)
--- 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,26 +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'};
-    return Cache::Memcached->new(
-        servers   => \@servers,
-        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;
+    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 );
     }
@@ -50,19 +87,31 @@ sub set_in_cache {
 
 sub get_from_cache {
     my ( $self, $key ) = @_;
-    croak "No key" unless $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;