| 
      
            Lines 1-6
          
      
      
        Link Here
      
     | 
  
        
          | 1 | 
          package Koha::Cache::Memcached;  | 
          1 | 
          package Koha::Cache::Memcached;  | 
        
        
          | 2 | 
           | 
          2 | 
           | 
        
          
            
              | 3 | 
              # Copyright 2009 Chris Cormack and The Koha Dev Team  | 
              3 | 
              # Copyright 2012 C & P Bibliography Services  | 
            
        
          | 4 | 
          #  | 
          4 | 
          #  | 
        
        
          | 5 | 
          # This file is part of Koha.  | 
          5 | 
          # This file is part of Koha.  | 
        
        
          | 6 | 
          #  | 
          6 | 
          #  | 
        
  
    | 
      
            Lines 20-50
          package Koha::Cache::Memcached;
      
      
        Link Here
      
     | 
  
        
          | 20 | 
          use strict;  | 
          20 | 
          use strict;  | 
        
        
          | 21 | 
          use warnings;  | 
          21 | 
          use warnings;  | 
        
        
          | 22 | 
          use Carp;  | 
          22 | 
          use Carp;  | 
        
          
            
              | 23 | 
               | 
              23 | 
              use Cache::Memcached::Fast;  | 
            
            
              | 24 | 
              use Cache::Memcached;  | 
              24 | 
              use Module::Load::Conditional qw(can_load);  | 
            
        
          | 25 | 
           | 
          25 | 
           | 
        
        
          | 26 | 
          use base qw(Koha::Cache);  | 
          26 | 
          use base qw(Koha::Cache);  | 
        
        
          | 27 | 
           | 
          27 | 
           | 
        
        
          | 28 | 
          sub _cache_handle { | 
          28 | 
          sub _cache_handle { | 
        
          
            
              | 29 | 
                  my $class  = shift;  | 
              29 | 
                  my $class   = shift;  | 
            
            
              | 30 | 
                  my $params = shift;  | 
              30 | 
                  my $params  = shift;  | 
            
            
              | 31 | 
                  my @servers = split /,/, $params->{'cache_servers'}?$params->{'cache_servers'}:$ENV{MEMCACHED_SERVERS}; | 
              31 | 
                  my @servers = split /,/,  | 
            
            
              | 32 | 
                  $ENV{DEBUG} && warn "Caching server settings: ".join(', ',@servers)." with ".($ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha'); | 
              32 | 
                    $params->{'cache_servers'} | 
            
            
              | 33 | 
                  return Cache::Memcached->new(  | 
              33 | 
                    ? $params->{'cache_servers'} | 
            
            
              | 34 | 
                      servers   => \@servers,  | 
              34 | 
                    : $ENV{MEMCACHED_SERVERS}; | 
            
            
              | 35 | 
                      debug   => 0,  | 
              35 | 
                  my $namespace =  | 
            
            
              | 36 | 
                      compress_threshold => 10_000,  | 
              36 | 
                       $ENV{MEMCACHED_NAMESPACE} | 
            
            
              | 37 | 
                      expire_time => 600,  | 
              37 | 
                    || $params->{'namespace'} | 
            
            
              | 38 | 
                      namespace => $ENV{MEMCACHED_NAMESPACE} || $params->{'namespace'} || 'koha', | 
              38 | 
                    || 'koha';  | 
            
            
              | 39 | 
                  );  | 
              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 | 
                  }  | 
            
        
          | 40 | 
          }  | 
          72 | 
          }  | 
        
        
          | 41 | 
           | 
          73 | 
           | 
        
        
          | 42 | 
          sub set_in_cache { | 
          74 | 
          sub set_in_cache { | 
        
        
          | 43 | 
              my ( $self, $key, $value, $expiry ) = @_;  | 
          75 | 
              my ( $self, $key, $value, $expiry ) = @_;  | 
        
          
            
              | 44 | 
                  croak "No key" unless $key;  | 
              76 | 
                  return $self->SUPER::set_in_cache( $key, $value, $expiry )  | 
            
            
              | 45 | 
                  $self->cache->set_debug;  | 
              77 | 
                    if ( $self->{have_chi} ); | 
            
            
              | 46 | 
                  $ENV{DEBUG} && warn "set_in_cache for Memcache $key"; | 
               | 
               | 
            
        
          | 47 | 
           | 
          78 | 
           | 
        
            
               | 
               | 
              79 | 
                  # No CHI, we have to use Cache::Memcached::Fast directly  | 
            
        
          | 48 | 
              if ( defined $expiry ) { | 
          80 | 
              if ( defined $expiry ) { | 
        
        
          | 49 | 
                  return $self->cache->set( $key, $value, $expiry );  | 
          81 | 
                  return $self->cache->set( $key, $value, $expiry );  | 
        
        
          | 50 | 
              }  | 
          82 | 
              }  | 
        
  
    | 
      
            Lines 55-74
          sub set_in_cache {
      
      
        Link Here
      
     | 
  
        
          | 55 | 
           | 
          87 | 
           | 
        
        
          | 56 | 
          sub get_from_cache { | 
          88 | 
          sub get_from_cache { | 
        
        
          | 57 | 
              my ( $self, $key ) = @_;  | 
          89 | 
              my ( $self, $key ) = @_;  | 
        
          
            
              | 58 | 
                  croak "No key" unless $key;  | 
              90 | 
                  return $self->SUPER::get_from_cache($key) if ( $self->{have_chi} ); | 
            
            
              | 59 | 
                  $ENV{DEBUG} && warn "get_from_cache for Memcache $key"; | 
              91 | 
               | 
            
            
               | 
               | 
              92 | 
                  # No CHI, we have to use Cache::Memcached::Fast directly  | 
            
        
          | 60 | 
              return $self->cache->get($key);  | 
          93 | 
              return $self->cache->get($key);  | 
        
        
          | 61 | 
          }  | 
          94 | 
          }  | 
        
        
          | 62 | 
           | 
          95 | 
           | 
        
        
          | 63 | 
          sub clear_from_cache { | 
          96 | 
          sub clear_from_cache { | 
        
        
          | 64 | 
              my ( $self, $key ) = @_;  | 
          97 | 
              my ( $self, $key ) = @_;  | 
        
          
            
              | 65 | 
                  croak "No key" unless $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  | 
            
        
          | 66 | 
              return $self->cache->delete($key);  | 
          101 | 
              return $self->cache->delete($key);  | 
        
        
          | 67 | 
          }  | 
          102 | 
          }  | 
        
        
          | 68 | 
           | 
          103 | 
           | 
        
            
               | 
               | 
              104 | 
              # We have to overload flush_all because CHI::Driver::Memcached::Fast does not  | 
            
            
              | 105 | 
              # support the clear() method  | 
            
        
          | 69 | 
          sub flush_all { | 
          106 | 
          sub flush_all { | 
        
        
          | 70 | 
              my $self = shift;  | 
          107 | 
              my $self = shift;  | 
        
          
            
              | 71 | 
                  return $self->cache->flush_all;  | 
              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 | 
                  }  | 
            
        
          | 72 | 
          }  | 
          115 | 
          }  | 
        
        
          | 73 | 
           | 
          116 | 
           | 
        
        
          | 74 | 
          1;  | 
          117 | 
          1;  |