Bug 16221: follow-up for changes made by bug 16229

[koha-ffzg.git] / Koha / Cache.pm

diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index 0c9558d..7793f06 100644 (file)
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -38,7 +38,7 @@ The first, traditional OO interface provides the following functions:
 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;
 
@@ -84,43 +84,29 @@ sub new {
     $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'};
-        }
-    }
-
-    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'};
-        }
+      && can_load( modules => { 'Cache::FastMmap' => undef } )
+      && _initialize_fastmmap($self)
+      && defined( $self->{'fastmmap_cache'} ) )
+    {
+        $self->{'cache'} = $self->{'fastmmap_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, nocache => 1 } )
+            && _initialize_memory($self) )
+        {
+                $self->{'cache'} = $self->{'memory_cache'};
         }
     }
 
@@ -242,12 +228,12 @@ The possible options are:
 
 Expiry time of this cached entry in seconds.
 
-=item deepcopy
+=item unsafe
 
-If set, this will perform a deep copy of the item when it's retrieved. This
-means that it'll be safe if something later modifies the result of the
-function. Will be ignored in situations where the same behaviour comes from
-the caching layer anyway.
+If set, this will avoid performing a deep copy of the item. This
+means that it won't be safe if something later modifies the result of the
+function. It should be used with caution, and could save processing time
+in some situations where is safe to use it.
 
 =item cache
 
@@ -267,6 +253,7 @@ sub set_in_cache {
         $new_options->{cache} = $_cache if defined $_cache;
         $options = $new_options;
     }
+    my $unsafe = $options->{unsafe} || 0;
 
     # the key mustn't contain whitespace (or control characters) for memcache
     # but shouldn't be any harm in applying it globally.
@@ -281,6 +268,9 @@ sub set_in_cache {
     $expiry //= $self->{timeout};
     my $set_sub = $self->{ref($self->{$cache}) . "_set"};
 
+    # Deep copy if it's not a scalar and unsafe is not passed
+    $value = dclone( $value ) if ref($value) and not $unsafe;
+
     # Set in L1 cache
     $L1_cache{ $key } = $value;
 
@@ -303,10 +293,23 @@ sub set_in_cache {
 
 Retrieve the value stored under the specified key in the default cache.
 
-The options can set an unsafe flag to avoid a deep copy.
-When this flag is set, you have to know what you are doing!
-If you are retrieving a structure and modify it, you will modify the contain
-of the cache!
+The possible options are:
+
+=over
+
+=item unsafe
+
+If set, this will avoid performing a deep copy of the item. This
+means that it won't be safe if something later modifies the result of the
+function. It should be used with caution, and could save processing time
+in some situations where is safe to use it. Make sure you know what you are doing!
+
+=item cache
+
+The cache object to use if you want to provide your own. It should be an
+instance of C<Cache::*> and follow the same interface as L<Cache::Memcache>.
+
+=back
 
 =cut
 
@@ -325,7 +328,7 @@ sub get_from_cache {
         # 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"};
@@ -335,7 +338,7 @@ sub get_from_cache {
     # 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;
 }