Lines 13-18
our $VERSION = '0.03';
Link Here
|
13 |
use Data::Dumper; |
13 |
use Data::Dumper; |
14 |
$Data::Dumper::Sortkeys = 1; |
14 |
$Data::Dumper::Sortkeys = 1; |
15 |
|
15 |
|
|
|
16 |
warn "## FIXME ",__PACKAGE__, " patched with in-memory cache for fetch!"; |
16 |
|
17 |
|
17 |
use base 'Exporter'; |
18 |
use base 'Exporter'; |
18 |
|
19 |
|
Lines 80-85
sub flush_cache {
Link Here
|
80 |
# Memoize, even though it cannot be handled correctly at this time |
81 |
# Memoize, even though it cannot be handled correctly at this time |
81 |
# (whatever we do will be wrong, anyway). |
82 |
# (whatever we do will be wrong, anyway). |
82 |
|
83 |
|
|
|
84 |
warn "## flush_cache"; |
85 |
|
83 |
goto &Memoize::flush_cache if @_ == 1; |
86 |
goto &Memoize::flush_cache if @_ == 1; |
84 |
|
87 |
|
85 |
|
88 |
|
Lines 246-264
sub STORE {
Link Here
|
246 |
my @args = ($key, $value); |
249 |
my @args = ($key, $value); |
247 |
push @args, $self->{expire_time} if defined $self->{expire_time}; |
250 |
push @args, $self->{expire_time} if defined $self->{expire_time}; |
248 |
$self->{memcached_obj}->set(@args); |
251 |
$self->{memcached_obj}->set(@args); |
|
|
252 |
warn "## STORE $key $value"; |
249 |
return $self; |
253 |
return $self; |
250 |
} |
254 |
} |
251 |
|
255 |
|
|
|
256 |
our $cache; |
252 |
|
257 |
|
253 |
sub FETCH { |
258 |
sub FETCH { |
254 |
my $self = shift; |
259 |
my $self = shift; |
255 |
my $key = $self->_get_key(shift); |
260 |
my $key = $self->_get_key(shift); |
256 |
return $self->{memcached_obj}->get($key); |
261 |
if ( exists $cache->{$key} ) { |
|
|
262 |
$Koha::Persistant::stats->{memcache_FETCH}->[0]++; |
263 |
return $cache->{$key}; |
264 |
} |
265 |
$Koha::Persistant::stats->{memcache_FETCH}->[1]++; |
266 |
warn "## FETCH $key"; |
267 |
my $v = $self->{memcached_obj}->get($key); |
268 |
$cache->{$key} = $v; |
269 |
return $v; |
257 |
} |
270 |
} |
258 |
|
271 |
|
259 |
|
|
|
260 |
sub EXISTS { |
272 |
sub EXISTS { |
261 |
my $self = shift; |
273 |
my $self = shift; |
|
|
274 |
warn "## EXISTS @_"; |
262 |
return defined $self->FETCH(@_); |
275 |
return defined $self->FETCH(@_); |
263 |
} |
276 |
} |
264 |
|
277 |
|
Lines 267-272
sub DELETE {
Link Here
|
267 |
my $self = shift; |
280 |
my $self = shift; |
268 |
my $key = $self->_get_key(shift); |
281 |
my $key = $self->_get_key(shift); |
269 |
$self->{memcached_obj}->delete($key); |
282 |
$self->{memcached_obj}->delete($key); |
|
|
283 |
warn "## DELETE $key"; |
270 |
return $self; |
284 |
return $self; |
271 |
} |
285 |
} |
272 |
|
286 |
|
Lines 275-280
sub CLEAR {
Link Here
|
275 |
my $self = shift; |
289 |
my $self = shift; |
276 |
# This is not safe because all object share memcached setup. |
290 |
# This is not safe because all object share memcached setup. |
277 |
$self->{memcached_obj}->flush_all; |
291 |
$self->{memcached_obj}->flush_all; |
|
|
292 |
warn "## CLEAR"; |
278 |
return $self; |
293 |
return $self; |
279 |
} |
294 |
} |
280 |
|
295 |
|