Lines 38-46
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(freeze thaw); |
|
|
42 |
use Module::Load::Conditional qw(can_load); |
41 |
use Module::Load::Conditional qw(can_load); |
43 |
use Koha::Cache::Object; |
42 |
use Koha::Cache::Object; |
|
|
43 |
use Sereal; |
44 |
|
44 |
|
45 |
use base qw(Class::Accessor); |
45 |
use base qw(Class::Accessor); |
46 |
|
46 |
|
Lines 48-53
__PACKAGE__->mk_ro_accessors(
Link Here
|
48 |
qw( cache memcached_cache fastmmap_cache memory_cache )); |
48 |
qw( cache memcached_cache fastmmap_cache memory_cache )); |
49 |
|
49 |
|
50 |
our %L1_cache; |
50 |
our %L1_cache; |
|
|
51 |
our $L1_encoder = Sereal::Encoder->new; |
52 |
our $L1_decoder = Sereal::Decoder->new; |
51 |
|
53 |
|
52 |
=head2 get_instance |
54 |
=head2 get_instance |
53 |
|
55 |
|
Lines 263-269
sub set_in_cache {
Link Here
|
263 |
my $flag = '-CF0'; # 0: scalar, 1: frozen data structure |
265 |
my $flag = '-CF0'; # 0: scalar, 1: frozen data structure |
264 |
if (ref($value)) { |
266 |
if (ref($value)) { |
265 |
# Set in L1 cache as a data structure, initially only in frozen form (for performance reasons) |
267 |
# Set in L1 cache as a data structure, initially only in frozen form (for performance reasons) |
266 |
$value = freeze($value); |
268 |
$value = $L1_encoder->encode($value); |
267 |
$L1_cache{$key}->{frozen} = $value; |
269 |
$L1_cache{$key}->{frozen} = $value; |
268 |
$flag = '-CF1'; |
270 |
$flag = '-CF1'; |
269 |
} else { |
271 |
} else { |
Lines 325-334
sub get_from_cache {
Link Here
|
325 |
if ( exists $L1_cache{$key} ) { |
327 |
if ( exists $L1_cache{$key} ) { |
326 |
if (ref($L1_cache{$key})) { |
328 |
if (ref($L1_cache{$key})) { |
327 |
if ($unsafe) { |
329 |
if ($unsafe) { |
328 |
$L1_cache{$key}->{thawed} ||= thaw($L1_cache{$key}->{frozen}); |
330 |
$L1_cache{$key}->{thawed} ||= $L1_decoder->decode($L1_cache{$key}->{frozen}); |
329 |
return $L1_cache{$key}->{thawed}; |
331 |
return $L1_cache{$key}->{thawed}; |
330 |
} else { |
332 |
} else { |
331 |
return thaw($L1_cache{$key}->{frozen}); |
333 |
return $L1_decoder->decode($L1_cache{$key}->{frozen}); |
332 |
} |
334 |
} |
333 |
} else { |
335 |
} else { |
334 |
# No need to thaw if it's a scalar |
336 |
# No need to thaw if it's a scalar |
Lines 350-356
sub get_from_cache {
Link Here
|
350 |
} elsif ($flag eq '-CF1') { |
352 |
} elsif ($flag eq '-CF1') { |
351 |
# it's a frozen data structure |
353 |
# it's a frozen data structure |
352 |
my $thawed; |
354 |
my $thawed; |
353 |
eval { $thawed = thaw($L2_value); }; |
355 |
eval { $thawed = $L1_decoder->decode($L2_value); }; |
354 |
return if $@; |
356 |
return if $@; |
355 |
$L1_cache{$key}->{frozen} = $L2_value; |
357 |
$L1_cache{$key}->{frozen} = $L2_value; |
356 |
$L1_cache{$key}->{thawed} = $thawed if $unsafe; |
358 |
$L1_cache{$key}->{thawed} = $thawed if $unsafe; |
357 |
- |
|
|