Bug 17669: [QA Follow-up] More consistency in return values of delete

[srvgit] / Koha / Cache.pm

diff --git a/Koha/Cache.pm b/Koha/Cache.pm
index be12512..5af8c0e 100644 (file)
--- a/Koha/Cache.pm
+++ b/Koha/Cache.pm
@@ -27,6 +27,8 @@ Koha::Cache - Handling caching of html and Objects for Koha
   use Koha::Cache;
   my $cache = Koha::Cache->new({cache_type => $cache_type, %params});
 
+  # see also Koha::Caches->get_instance;
+
 =head1 DESCRIPTION
 
 Koha caching routines. This class provides two interfaces for cache access.
@@ -35,6 +37,7 @@ The first, traditional OO interface provides the following functions:
 =head1 FUNCTIONS
 
 =cut
+
 use strict;
 use warnings;
 use Carp;
@@ -54,16 +57,6 @@ our %L1_cache;
 our $L1_encoder = Sereal::Encoder->new;
 our $L1_decoder = Sereal::Decoder->new;
 
-=head2 get_instance
-
-    my $cache = Koha::Caches->get_instance();
-
-This gets a shared instance of the cache, set up in a very default way. This is
-the recommended way to fetch a cache object. If possible, it'll be
-persistent across multiple instances.
-
-=cut
-
 =head2 new
 
 Create a new Koha::Cache object. This is required for all cache-related functionality.
@@ -88,7 +81,8 @@ sub new {
     unless ( $self->{namespace} and @servers ) {
         my $koha_config = Koha::Config->read_from_file( Koha::Config->guess_koha_conf() );
         $self->{namespace} ||= $koha_config->{config}{memcached_namespace} || 'koha';
-        @servers = split /,/, $koha_config->{config}{memcached_servers} unless @servers;
+        @servers = split /,/, $koha_config->{config}{memcached_servers} // ''
+            unless @servers;
     }
     $self->{namespace} .= ":$subnamespace:";
 
@@ -243,14 +237,9 @@ instance of C<Cache::*> and follow the same interface as L<Cache::Memcache>.
 =cut
 
 sub set_in_cache {
-    my ( $self, $key, $value, $options, $_cache) = @_;
-    # This is a bit of a hack to support the old API in case things still use it
-    if (defined $options && (ref($options) ne 'HASH')) {
-        my $new_options;
-        $new_options->{expiry} = $options;
-        $new_options->{cache} = $_cache if defined $_cache;
-        $options = $new_options;
-    }
+    my ( $self, $key, $value, $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.
@@ -267,7 +256,10 @@ sub set_in_cache {
 
     my $flag = '-CF0'; # 0: scalar, 1: frozen data structure
     if (ref($value)) {
-        # Set in L1 cache as a data structure, initially only in frozen form (for performance reasons)
+        # Set in L1 cache as a data structure
+        # We only save the frozen form: we do want to save $value in L1
+        # directly in order to protect it. And thawing now may not be
+        # needed, so improves performance.
         $value = $L1_encoder->encode($value);
         $L1_cache{$self->{namespace}}{$key}->{frozen} = $value;
         $flag = '-CF1';
@@ -278,7 +270,7 @@ sub set_in_cache {
     }
 
     $value .= $flag;
-    # 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 )
@@ -330,7 +322,8 @@ sub get_from_cache {
     if ( exists $L1_cache{$self->{namespace}}{$key} ) {
         if (ref($L1_cache{$self->{namespace}}{$key})) {
             if ($unsafe) {
-                $L1_cache{$self->{namespace}}{$key}->{thawed} ||= $L1_decoder->decode($L1_cache{$self->{namespace}}{key}->{frozen});
+                # ONLY use thawed for unsafe calls !!!
+                $L1_cache{$self->{namespace}}{$key}->{thawed} ||= $L1_decoder->decode($L1_cache{$self->{namespace}}{$key}->{frozen});
                 return $L1_cache{$self->{namespace}}{$key}->{thawed};
             } else {
                 return $L1_decoder->decode($L1_cache{$self->{namespace}}{$key}->{frozen});
@@ -358,6 +351,7 @@ sub get_from_cache {
         eval { $thawed = $L1_decoder->decode($L2_value); };
         return if $@;
         $L1_cache{$self->{namespace}}{$key}->{frozen} = $L2_value;
+        # ONLY save thawed for unsafe calls !!!
         $L1_cache{$self->{namespace}}{$key}->{thawed} = $thawed if $unsafe;
         return $thawed;
     }