View | Details | Raw Unified | Return to bug 7879
Collapse All | Expand All

(-)a/misc/plack/lib/Memoize/Memcached.pm (-2 / +17 lines)
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

Return to bug 7879