| Lines 13-18
          our $VERSION = '0.03';
      
      
        Link Here | 
        
          | 13 | use Data::Dumper; | 13 | use Data::Dumper; | 
        
          | 14 | $Data::Dumper::Sortkeys = 1; | 14 | $Data::Dumper::Sortkeys = 1; | 
        
          | 15 |  | 15 |  | 
            
              |  |  | 16 | warn "## FIXME ",__PACKAGE__, " patched with in-memory cache for fetch!"; | 
        
          | 16 |  | 17 |  | 
        
          | 17 | use base 'Exporter'; | 18 | use base 'Exporter'; | 
        
          | 18 |  | 19 |  | 
  
    | Lines 80-85
          sub flush_cache {
      
      
        Link Here | 
        
          | 80 |   # Memoize, even though it cannot be handled correctly at this time | 81 |   # Memoize, even though it cannot be handled correctly at this time | 
        
          | 81 |   # (whatever we do will be wrong, anyway). | 82 |   # (whatever we do will be wrong, anyway). | 
        
          | 82 |  | 83 |  | 
            
              |  |  | 84 | warn "## flush_cache"; | 
            
              | 85 |  | 
        
          | 83 |   goto &Memoize::flush_cache if @_ == 1; | 86 |   goto &Memoize::flush_cache if @_ == 1; | 
        
          | 84 |  | 87 |  | 
        
          | 85 |  | 88 |  | 
  
    | Lines 246-264
          sub STORE {
      
      
        Link Here | 
        
          | 246 |   my @args = ($key, $value); | 249 |   my @args = ($key, $value); | 
        
          | 247 |   push @args, $self->{expire_time} if defined $self->{expire_time}; | 250 |   push @args, $self->{expire_time} if defined $self->{expire_time}; | 
        
          | 248 |   $self->{memcached_obj}->set(@args); | 251 |   $self->{memcached_obj}->set(@args); | 
            
              |  |  | 252 | warn "## STORE $key $value"; | 
        
          | 249 |   return $self; | 253 |   return $self; | 
        
          | 250 | } | 254 | } | 
        
          | 251 |  | 255 |  | 
            
              |  |  | 256 | our $cache; | 
        
          | 252 |  | 257 |  | 
        
          | 253 | sub FETCH { | 258 | sub FETCH { | 
        
          | 254 |   my $self = shift; | 259 |   my $self = shift; | 
        
          | 255 |   my $key = $self->_get_key(shift); | 260 |   my $key = $self->_get_key(shift); | 
          
            
              | 256 |   return $self->{memcached_obj}->get($key); | 261 |   if ( exists $cache->{$key} ) { | 
            
              |  |  | 262 | 	$Koha::Persistant::stats->{memcache_FETCH}->[0]++; | 
            
              | 263 | 	return $cache->{$key}; | 
            
              | 264 |   } | 
            
              | 265 |   $Koha::Persistant::stats->{memcache_FETCH}->[1]++; | 
            
              | 266 | warn "## FETCH $key"; | 
            
              | 267 |   my $v = $self->{memcached_obj}->get($key); | 
            
              | 268 |   $cache->{$key} = $v; | 
            
              | 269 |   return $v; | 
        
          | 257 | } | 270 | } | 
        
          | 258 |  | 271 |  | 
            
              | 259 |  |  |  | 
        
          | 260 | sub EXISTS { | 272 | sub EXISTS { | 
        
          | 261 |   my $self = shift; | 273 |   my $self = shift; | 
            
              |  |  | 274 | warn "## EXISTS @_"; | 
        
          | 262 |   return defined $self->FETCH(@_); | 275 |   return defined $self->FETCH(@_); | 
        
          | 263 | } | 276 | } | 
        
          | 264 |  | 277 |  | 
  
    | Lines 267-272
          sub DELETE {
      
      
        Link Here | 
        
          | 267 |   my $self = shift; | 280 |   my $self = shift; | 
        
          | 268 |   my $key = $self->_get_key(shift); | 281 |   my $key = $self->_get_key(shift); | 
        
          | 269 |   $self->{memcached_obj}->delete($key); | 282 |   $self->{memcached_obj}->delete($key); | 
            
              |  |  | 283 | warn "## DELETE $key"; | 
        
          | 270 |   return $self; | 284 |   return $self; | 
        
          | 271 | } | 285 | } | 
        
          | 272 |  | 286 |  | 
  
    | Lines 275-280
          sub CLEAR {
      
      
        Link Here | 
        
          | 275 |   my $self = shift; | 289 |   my $self = shift; | 
        
          | 276 |   # This is not safe because all object share memcached setup. | 290 |   # This is not safe because all object share memcached setup. | 
        
          | 277 |   $self->{memcached_obj}->flush_all; | 291 |   $self->{memcached_obj}->flush_all; | 
            
              |  |  | 292 | warn "## CLEAR"; | 
        
          | 278 |   return $self; | 293 |   return $self; | 
        
          | 279 | } | 294 | } | 
        
          | 280 |  | 295 |  |