|
Lines 46-51
use base qw(Class::Accessor);
Link Here
|
| 46 |
__PACKAGE__->mk_ro_accessors( |
46 |
__PACKAGE__->mk_ro_accessors( |
| 47 |
qw( cache memcached_cache fastmmap_cache memory_cache )); |
47 |
qw( cache memcached_cache fastmmap_cache memory_cache )); |
| 48 |
|
48 |
|
|
|
49 |
our %L1_cache; |
| 50 |
|
| 49 |
=head2 get_instance |
51 |
=head2 get_instance |
| 50 |
|
52 |
|
| 51 |
my $cache = Koha::Cache->get_instance(); |
53 |
my $cache = Koha::Cache->get_instance(); |
|
Lines 277-282
sub set_in_cache {
Link Here
|
| 277 |
my $expiry = $options->{expiry}; |
279 |
my $expiry = $options->{expiry}; |
| 278 |
$expiry //= $self->{timeout}; |
280 |
$expiry //= $self->{timeout}; |
| 279 |
my $set_sub = $self->{ref($self->{$cache}) . "_set"}; |
281 |
my $set_sub = $self->{ref($self->{$cache}) . "_set"}; |
|
|
282 |
|
| 283 |
# Set in L1 cache |
| 284 |
$L1_cache{ $key } = $value; |
| 285 |
|
| 280 |
# We consider an expiry of 0 to be inifinite |
286 |
# We consider an expiry of 0 to be inifinite |
| 281 |
if ( $expiry ) { |
287 |
if ( $expiry ) { |
| 282 |
return $set_sub |
288 |
return $set_sub |
|
Lines 305-310
sub get_from_cache {
Link Here
|
| 305 |
croak "No key" unless $key; |
311 |
croak "No key" unless $key; |
| 306 |
$ENV{DEBUG} && carp "get_from_cache for $key"; |
312 |
$ENV{DEBUG} && carp "get_from_cache for $key"; |
| 307 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
313 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
|
|
314 |
|
| 315 |
# Return L1 cache value if exists |
| 316 |
return $L1_cache{$key} if exists $L1_cache{$key}; |
| 317 |
|
| 308 |
my $get_sub = $self->{ref($self->{$cache}) . "_get"}; |
318 |
my $get_sub = $self->{ref($self->{$cache}) . "_get"}; |
| 309 |
return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); |
319 |
return $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); |
| 310 |
} |
320 |
} |
|
Lines 323-328
sub clear_from_cache {
Link Here
|
| 323 |
$cache ||= 'cache'; |
333 |
$cache ||= 'cache'; |
| 324 |
croak "No key" unless $key; |
334 |
croak "No key" unless $key; |
| 325 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
335 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
|
|
336 |
|
| 337 |
# Clear from L1 cache |
| 338 |
delete $L1_cache{$key}; |
| 339 |
|
| 326 |
return $self->{$cache}->delete($key) |
340 |
return $self->{$cache}->delete($key) |
| 327 |
if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' ); |
341 |
if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' ); |
| 328 |
return $self->{$cache}->remove($key); |
342 |
return $self->{$cache}->remove($key); |
|
Lines 340-350
sub flush_all {
Link Here
|
| 340 |
my ( $self, $cache ) = shift; |
354 |
my ( $self, $cache ) = shift; |
| 341 |
$cache ||= 'cache'; |
355 |
$cache ||= 'cache'; |
| 342 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
356 |
return unless ( $self->{$cache} && ref( $self->{$cache} ) =~ m/^Cache::/ ); |
|
|
357 |
|
| 358 |
$self->flush_L1_cache(); |
| 359 |
|
| 343 |
return $self->{$cache}->flush_all() |
360 |
return $self->{$cache}->flush_all() |
| 344 |
if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' ); |
361 |
if ( ref( $self->{$cache} ) =~ m'^Cache::Memcached' ); |
| 345 |
return $self->{$cache}->clear(); |
362 |
return $self->{$cache}->clear(); |
| 346 |
} |
363 |
} |
| 347 |
|
364 |
|
|
|
365 |
sub flush_L1_cache { |
| 366 |
my( $self ) = @_; |
| 367 |
%L1_cache = (); |
| 368 |
} |
| 369 |
|
| 348 |
=head1 TIED INTERFACE |
370 |
=head1 TIED INTERFACE |
| 349 |
|
371 |
|
| 350 |
Koha::Cache also provides a tied interface which enables users to provide a |
372 |
Koha::Cache also provides a tied interface which enables users to provide a |