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; |