use strict;
use warnings;
use Carp;
-use Clone qw( clone );
+use Storable qw(dclone);
use Module::Load::Conditional qw(can_load);
use Koha::Cache::Object;
$self->{'timeout'} ||= 0;
$self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE} || 'koha';
- if ( can_load( modules => { 'Cache::Memcached::Fast' => undef } ) ) {
- _initialize_memcached($self);
- if ( $self->{'default_type'} eq 'memcached'
- && defined( $self->{'memcached_cache'} ) )
- {
- $self->{'cache'} = $self->{'memcached_cache'};
- }
+ if ( $self->{'default_type'} eq 'memcached'
+ && can_load( modules => { 'Cache::Memcached::Fast' => undef } )
+ && _initialize_memcached($self)
+ && defined( $self->{'memcached_cache'} ) )
+ {
+ $self->{'cache'} = $self->{'memcached_cache'};
}
if ( $self->{'default_type'} eq 'fastmmap'
&& defined( $ENV{GATEWAY_INTERFACE} )
- && can_load( modules => { 'Cache::FastMmap' => undef } ) ) {
- _initialize_fastmmap($self);
- if ( defined( $self->{'fastmmap_cache'} ) )
- {
- $self->{'cache'} = $self->{'fastmmap_cache'};
- }
+ && can_load( modules => { 'Cache::FastMmap' => undef } )
+ && _initialize_fastmmap($self)
+ && defined( $self->{'fastmmap_cache'} ) )
+ {
+ $self->{'cache'} = $self->{'fastmmap_cache'};
}
- if ( can_load( modules => { 'Cache::Memory' => undef } ) ) {
- _initialize_memory($self);
- if ( $self->{'default_type'} eq 'memory'
- && defined( $self->{'memory_cache'} ) )
- {
- $self->{'cache'} = $self->{'memory_cache'};
- }
- }
-
- # Unless a default has already been picked, we go through in best-to-
- # least-best order, looking for something we can use. fastmmap_cache
- # is excluded because it doesn't support expiry in a useful way.
+ # Unless memcache or fastmmap has already been picked, use memory_cache
unless ( defined( $self->{'cache'} ) ) {
- foreach my $cachemember (qw(memcached_cache memory_cache )) {
- if ( defined( $self->{$cachemember} ) ) {
- $self->{'cache'} = $self->{$cachemember};
- last;
- }
+ if ( can_load( modules => { 'Cache::Memory' => undef } )
+ && _initialize_memory($self) )
+ {
+ $self->{'cache'} = $self->{'memory_cache'};
}
}
my $set_sub = $self->{ref($self->{$cache}) . "_set"};
# Deep copy if it's not a scalar and unsafe is not passed
- $value = clone( $value ) if ref($value) and not $unsafe;
+ $value = dclone( $value ) if ref($value) and not $unsafe;
- # Set in L1 cache
+ # Set in L1 cache; exit if we are caching an undef
$L1_cache{ $key } = $value;
+ return if !defined $value;
- # We consider an expiry of 0 to be inifinite
+ # We consider an expiry of 0 to be infinite
if ( $expiry ) {
return $set_sub
? $set_sub->( $key, $value, $expiry )
# Or if we do not need to deep copy
return $L1_cache{$key}
if not ref $L1_cache{$key} or $unsafe;
- return clone $L1_cache{$key};
+ return dclone $L1_cache{$key};
}
my $get_sub = $self->{ref($self->{$cache}) . "_get"};
# Otherwise the L1 cache won't ever be populated
$L1_cache{$key} = $value;
- $value = clone $value if ref $L1_cache{$key} and not $unsafe;
+ $value = dclone $value if ref $L1_cache{$key} and not $unsafe;
return $value;
}