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

(-)a/C4/Installer/PerlDependencies.pm (+5 lines)
Lines 802-807 our $PERL_DEPS = { Link Here
802
        'required' => '1',
802
        'required' => '1',
803
        'min_ver'  => '0.14',
803
        'min_ver'  => '0.14',
804
    },
804
    },
805
    'Sereal' => {
806
        'usage'    => 'Caching',
807
        'required' => '1',
808
        'min_ver'  => '3.0',
809
    },
805
};
810
};
806
811
807
1;
812
1;
(-)a/Koha/Cache.pm (-6 / +7 lines)
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
- 

Return to bug 16166