| 
      
            Lines 38-44
          The first, traditional OO interface provides the following functions:
      
      
        Link Here
      
     | 
  
        
          | 38 | 
          use strict;  | 
          38 | 
          use strict;  | 
        
        
          | 39 | 
          use warnings;  | 
          39 | 
          use warnings;  | 
        
        
          | 40 | 
          use Carp;  | 
          40 | 
          use Carp;  | 
        
          
            
              | 41 | 
              use Storable qw(dclone);  | 
              41 | 
              use Storable qw(freeze thaw);  | 
            
        
          | 42 | 
          use Module::Load::Conditional qw(can_load);  | 
          42 | 
          use Module::Load::Conditional qw(can_load);  | 
        
        
          | 43 | 
          use Koha::Cache::Object;  | 
          43 | 
          use Koha::Cache::Object;  | 
        
        
          | 44 | 
           | 
          44 | 
           | 
        
  
    | 
      
            Lines 242-254
          The possible options are:
      
      
        Link Here
      
     | 
  
        
          | 242 | 
           | 
          242 | 
           | 
        
        
          | 243 | 
          Expiry time of this cached entry in seconds.  | 
          243 | 
          Expiry time of this cached entry in seconds.  | 
        
        
          | 244 | 
           | 
          244 | 
           | 
        
            
              | 245 | 
              =item unsafe  | 
               | 
               | 
            
            
              | 246 | 
               | 
            
            
              | 247 | 
              If set, this will avoid performing a deep copy of the item. This  | 
            
            
              | 248 | 
              means that it won't be safe if something later modifies the result of the  | 
            
            
              | 249 | 
              function. It should be used with caution, and could save processing time  | 
            
            
              | 250 | 
              in some situations where is safe to use it.  | 
            
            
              | 251 | 
               | 
            
        
          | 252 | 
          =item cache  | 
          245 | 
          =item cache  | 
        
        
          | 253 | 
           | 
          246 | 
           | 
        
        
          | 254 | 
          The cache object to use if you want to provide your own. It should be an  | 
          247 | 
          The cache object to use if you want to provide your own. It should be an  | 
        
  
    | 
      
            Lines 267-273
          sub set_in_cache {
      
      
        Link Here
      
     | 
  
        
          | 267 | 
                  $new_options->{cache} = $_cache if defined $_cache; | 
          260 | 
                  $new_options->{cache} = $_cache if defined $_cache; | 
        
        
          | 268 | 
                  $options = $new_options;  | 
          261 | 
                  $options = $new_options;  | 
        
        
          | 269 | 
              }  | 
          262 | 
              }  | 
        
            
              | 270 | 
                  my $unsafe = $options->{unsafe} || 0; | 
               | 
               | 
            
        
          | 271 | 
           | 
          263 | 
           | 
        
        
          | 272 | 
              # the key mustn't contain whitespace (or control characters) for memcache  | 
          264 | 
              # the key mustn't contain whitespace (or control characters) for memcache  | 
        
        
          | 273 | 
              # but shouldn't be any harm in applying it globally.  | 
          265 | 
              # but shouldn't be any harm in applying it globally.  | 
        
  
    | 
      
            Lines 282-293
          sub set_in_cache {
      
      
        Link Here
      
     | 
  
        
          | 282 | 
              $expiry //= $self->{timeout}; | 
          274 | 
              $expiry //= $self->{timeout}; | 
        
        
          | 283 | 
              my $set_sub = $self->{ref($self->{$cache}) . "_set"}; | 
          275 | 
              my $set_sub = $self->{ref($self->{$cache}) . "_set"}; | 
        
        
          | 284 | 
           | 
          276 | 
           | 
        
          
            
              | 285 | 
                  # Deep copy if it's not a scalar and unsafe is not passed  | 
              277 | 
                  my $flag = '-CF0'; # 0: scalar, 1: frozen data structure  | 
            
            
              | 286 | 
                  $value = dclone( $value ) if ref($value) and not $unsafe;  | 
               | 
               | 
            
            
              | 287 | 
               | 
            
        
          | 288 | 
              # Set in L1 cache  | 
          278 | 
              # Set in L1 cache  | 
        
          
            
              | 289 | 
                  $L1_cache{ $key } = $value; | 
              279 | 
                  if (ref($value)) { | 
            
            
               | 
               | 
              280 | 
                      $value = freeze($value);  | 
            
            
              | 281 | 
                      $L1_cache{$key}->{frozen} = $value; | 
            
            
              | 282 | 
                      $flag = '-CF1';  | 
            
            
              | 283 | 
                  } else { | 
            
            
              | 284 | 
                      $L1_cache{$key} = $value; | 
            
            
              | 285 | 
                  }  | 
            
        
          | 290 | 
           | 
          286 | 
           | 
        
            
               | 
               | 
              287 | 
                  $value .= $flag;  | 
            
        
          | 291 | 
              # We consider an expiry of 0 to be inifinite  | 
          288 | 
              # We consider an expiry of 0 to be inifinite  | 
        
        
          | 292 | 
              if ( $expiry ) { | 
          289 | 
              if ( $expiry ) { | 
        
        
          | 293 | 
                  return $set_sub  | 
          290 | 
                  return $set_sub  | 
        
  
    | 
      
            Lines 305-311
          sub set_in_cache {
      
      
        Link Here
      
     | 
  
        
          | 305 | 
           | 
          302 | 
           | 
        
        
          | 306 | 
              my $value = $cache->get_from_cache($key, [ $options ]);  | 
          303 | 
              my $value = $cache->get_from_cache($key, [ $options ]);  | 
        
        
          | 307 | 
           | 
          304 | 
           | 
        
          
            
              | 308 | 
              Retrieve the value stored under the specified key in the default cache.  | 
              305 | 
              Retrieve the value stored under the specified key in the cache.  | 
            
        
          | 309 | 
           | 
          306 | 
           | 
        
        
          | 310 | 
          The possible options are:  | 
          307 | 
          The possible options are:  | 
        
        
          | 311 | 
           | 
          308 | 
           | 
        
  
    | 
      
            Lines 338-360
          sub get_from_cache {
      
      
        Link Here
      
     | 
  
        
          | 338 | 
           | 
          335 | 
           | 
        
        
          | 339 | 
              # Return L1 cache value if exists  | 
          336 | 
              # Return L1 cache value if exists  | 
        
        
          | 340 | 
              if ( exists $L1_cache{$key} ) { | 
          337 | 
              if ( exists $L1_cache{$key} ) { | 
        
          
            
              | 341 | 
                      # No need to deep copy if it's a scalar  | 
              338 | 
                      if (ref($L1_cache{$key})) { | 
            
            
              | 342 | 
                      # Or if we do not need to deep copy  | 
              339 | 
                          if ($unsafe) { | 
            
            
              | 343 | 
                      return $L1_cache{$key} | 
              340 | 
                              $L1_cache{$key}->{thawed} ||= thaw($L1_cache{$key}->{frozen}); | 
            
            
              | 344 | 
                          if not ref $L1_cache{$key} or $unsafe; | 
              341 | 
                              return $L1_cache{$key}->{thawed}; | 
            
            
              | 345 | 
                      return dclone $L1_cache{$key}; | 
              342 | 
                          } else { | 
            
            
               | 
               | 
              343 | 
                              return thaw($L1_cache{$key}->{frozen}); | 
            
            
              | 344 | 
                          }  | 
            
            
              | 345 | 
                      } else { | 
            
            
              | 346 | 
                          # No need to thaw if it's a scalar  | 
            
            
              | 347 | 
                          return $L1_cache{$key}; | 
            
            
              | 348 | 
                      }  | 
            
        
          | 346 | 
              }  | 
          349 | 
              }  | 
        
        
          | 347 | 
           | 
          350 | 
           | 
        
        
          | 348 | 
              my $get_sub = $self->{ref($self->{$cache}) . "_get"}; | 
          351 | 
              my $get_sub = $self->{ref($self->{$cache}) . "_get"}; | 
        
          
            
              | 349 | 
                  my $value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); | 
              352 | 
                  my $L2_value = $get_sub ? $get_sub->($key) : $self->{$cache}->get($key); | 
            
            
              | 350 | 
               | 
              353 | 
               | 
            
            
              | 351 | 
                  # Update the L1 cache when fetching the L2 cache  | 
              354 | 
                  return if ref($L2_value);  | 
            
            
              | 352 | 
                  # Otherwise the L1 cache won't ever be populated  | 
              355 | 
                  return unless (defined($L2_value) && length($L2_value) >= 4);  | 
            
            
              | 353 | 
                  $L1_cache{$key} = $value; | 
              356 | 
               | 
            
            
              | 354 | 
               | 
              357 | 
                  my $flag = substr($L2_value, -4, 4, '');  | 
            
            
              | 355 | 
                  $value = dclone $value if ref $L1_cache{$key} and not $unsafe; | 
              358 | 
                  if ($flag eq '-CF0') { | 
            
            
               | 
               | 
              359 | 
                      # it's a scalar  | 
            
            
              | 360 | 
                      $L1_cache{$key} = $L2_value; | 
            
            
              | 361 | 
                      return $L2_value;  | 
            
            
              | 362 | 
                  } elsif ($flag eq '-CF1') { | 
            
            
              | 363 | 
                      # it's a frozen data structure  | 
            
            
              | 364 | 
                      my $thawed;  | 
            
            
              | 365 | 
                      eval { $thawed = thaw($L2_value); }; | 
            
            
              | 366 | 
                      return if $@;  | 
            
            
              | 367 | 
                      $L1_cache{$key}->{frozen} = $L2_value; | 
            
            
              | 368 | 
                      $L1_cache{$key}->{thawed} = $thawed if $unsafe; | 
            
            
              | 369 | 
                      return $thawed;  | 
            
            
              | 370 | 
                  }  | 
            
        
          | 356 | 
           | 
          371 | 
           | 
        
          
            
              | 357 | 
                  return $value;  | 
              372 | 
                  # Unknown value / data type returned from L2 cache  | 
            
            
               | 
               | 
              373 | 
                  return;  | 
            
        
          | 358 | 
          }  | 
          374 | 
          }  | 
        
        
          | 359 | 
           | 
          375 | 
           | 
        
        
          | 360 | 
          =head2 clear_from_cache  | 
          376 | 
          =head2 clear_from_cache  | 
        
            
              | 361 | 
              -   | 
               | 
               |