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

(-)a/Koha/Acquisition/Currencies.pm (-1 / +1 lines)
Lines 38-44 Koha::Acquisition::Currencies - Koha Acquisition Currency Object set class Link Here
38
=cut
38
=cut
39
39
40
sub get_active {
40
sub get_active {
41
    my ( $self ) = @_;
41
    my ($self) = @_;
42
    return $self->search( { active => 1 } )->next;
42
    return $self->search( { active => 1 } )->next;
43
}
43
}
44
44
(-)a/Koha/Object.pm (-1 / +1 lines)
Lines 1017-1023 sub AUTOLOAD { Link Here
1017
        my $accessor = sub {
1017
        my $accessor = sub {
1018
            my $self = shift;
1018
            my $self = shift;
1019
            if (@_) {
1019
            if (@_) {
1020
                if ($self->isa("Koha::Object::CachedExpiration")) {
1020
                if ( $self->isa("Koha::Object::CachedExpiration") ) {
1021
                    $self->_objects_cache_expire();
1021
                    $self->_objects_cache_expire();
1022
                }
1022
                }
1023
                $self->_result()->set_column( $method, @_ );
1023
                $self->_result()->set_column( $method, @_ );
(-)a/Koha/Object/CachedExpiration.pm (-3 / +3 lines)
Lines 52-60 sub store { Link Here
52
52
53
sub _objects_cache_expire {
53
sub _objects_cache_expire {
54
    my ($self) = @_;
54
    my ($self) = @_;
55
    if ($self->_result->in_storage) {
55
    if ( $self->_result->in_storage ) {
56
        my @primary_keys = $self->_result->id;
56
        my @primary_keys  = $self->_result->id;
57
        my $ids_cache_key = $self->_objects_cache_cache_key('find', @primary_keys);
57
        my $ids_cache_key = $self->_objects_cache_cache_key( 'find', @primary_keys );
58
        $self->_objects_cache_clear($ids_cache_key);
58
        $self->_objects_cache_clear($ids_cache_key);
59
    }
59
    }
60
}
60
}
(-)a/Koha/Objects.pm (-3 / +1 lines)
Lines 27-33 use Scalar::Util qw( reftype ); Link Here
27
use Koha::Database;
27
use Koha::Database;
28
use Koha::Exceptions::Object;
28
use Koha::Exceptions::Object;
29
29
30
31
=head1 NAME
30
=head1 NAME
32
31
33
Koha::Objects - Koha Object set base class
32
Koha::Objects - Koha Object set base class
Lines 144-150 sub search { Link Here
144
        }
143
        }
145
    ) if defined $attributes;
144
    ) if defined $attributes;
146
145
147
    my $rs = $self->_resultset()->search( $params, $attributes );
146
    my $rs    = $self->_resultset()->search( $params, $attributes );
148
    my $class = ref($self) ? ref($self) : $self;
147
    my $class = ref($self) ? ref($self) : $self;
149
148
150
    return $class->_new_from_dbic($rs);
149
    return $class->_new_from_dbic($rs);
Lines 332-338 sub _build_extended_attributes_relations { Link Here
332
    return map { 'extended_attributes_' . $_ } @{$types};
331
    return map { 'extended_attributes_' . $_ } @{$types};
333
}
332
}
334
333
335
336
=head3 search_related
334
=head3 search_related
337
335
338
    my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
336
    my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? );
(-)a/Koha/Objects/Cached.pm (-22 / +22 lines)
Lines 26-48 Overloaded I<find> method that provides in memory caching by arguments. Link Here
26
=cut
26
=cut
27
27
28
sub find {
28
sub find {
29
    my ($class, @args) = @_;
29
    my ( $class, @args ) = @_;
30
    my $cache_key = $class->_objects_cache_cache_key('find', @args);
30
    my $cache_key = $class->_objects_cache_cache_key( 'find', @args );
31
31
    # Store in the args bucket if has column value condiditions
32
    # Store in the args bucket if has column value condiditions
32
    # or for some reason the attributes argument is provided
33
    # or for some reason the attributes argument is provided
33
    my $has_options = @args > 1 && ref $args[$#args] eq 'HASH';
34
    my $has_options  = @args > 1 && ref $args[$#args] eq 'HASH';
34
    my $cache = !($has_options && defined $args[$#args]->{cache} && !$args[$#args]->{cache});
35
    my $cache        = !( $has_options && defined $args[$#args]->{cache} && !$args[$#args]->{cache} );
35
    my $cache_bucket = ref $args[0] eq 'HASH' || $has_options ? 'args' : 'ids';
36
    my $cache_bucket = ref $args[0] eq 'HASH' || $has_options ? 'args' : 'ids';
36
    my $object;
37
    my $object;
37
    if ($cache) {
38
    if ($cache) {
38
        $object = $class->_objects_cache_get($cache_key, $cache_bucket);
39
        $object = $class->_objects_cache_get( $cache_key, $cache_bucket );
39
    }
40
    }
40
    if (!defined $object) {
41
    if ( !defined $object ) {
41
        $object = $class->SUPER::find(@args);
42
        $object = $class->SUPER::find(@args);
42
        $object //= 'undef';
43
        $object //= 'undef';
43
        $class->_objects_cache_set($cache_key, $object, $cache_bucket) if $cache;
44
        $class->_objects_cache_set( $cache_key, $object, $cache_bucket ) if $cache;
44
    }
45
    } elsif ( $object ne 'undef' && defined $object->{'_cache'} ) {
45
    elsif ($object ne 'undef' && defined $object->{'_cache'}) {
46
46
        # Clear object cache if set
47
        # Clear object cache if set
47
        delete $object->{'_cache'};
48
        delete $object->{'_cache'};
48
    }
49
    }
Lines 56-82 Overloaded I<search> method that provides in memory caching by arguments. Link Here
56
=cut
57
=cut
57
58
58
sub search {
59
sub search {
59
    my ($class, $cond, $attrs) = @_;
60
    my ( $class, $cond, $attrs ) = @_;
60
    my $has_resultset = ref($class) && $class->{_resultset};
61
    my $has_resultset = ref($class) && $class->{_resultset};
61
    $attrs //= {};
62
    $attrs //= {};
62
    $attrs->{cache} //= 1 unless $has_resultset;
63
    $attrs->{cache} //= 1 unless $has_resultset;
63
64
64
    if ($has_resultset || !$attrs->{cache}) {
65
    if ( $has_resultset || !$attrs->{cache} ) {
65
        return $class->SUPER::search($cond, $attrs);
66
        return $class->SUPER::search( $cond, $attrs );
66
    }
67
    } else {
67
    else {
68
        my @args;
68
        my @args;
69
        push(@args , $cond) if defined $cond;
69
        push( @args, $cond ) if defined $cond;
70
70
        # Don't include if only contains "cache" key
71
        # Don't include if only contains "cache" key
71
        push(@args, $attrs) unless keys %{$attrs} == 1 && defined $attrs->{cache};
72
        push( @args, $attrs ) unless keys %{$attrs} == 1 && defined $attrs->{cache};
72
        my $cache_key = $class->_objects_cache_cache_key('search', @args);
73
        my $cache_key = $class->_objects_cache_cache_key( 'search', @args );
73
        my $objects = $class->_objects_cache_get($cache_key, 'args');
74
        my $objects   = $class->_objects_cache_get( $cache_key, 'args' );
74
        if ($objects) {
75
        if ($objects) {
75
            $objects->reset;
76
            $objects->reset;
76
        }
77
        } else {
77
        else {
78
            $objects = $class->SUPER::search( $cond, $attrs );
78
            $objects = $class->SUPER::search($cond, $attrs);
79
            $class->_objects_cache_set( $cache_key, $objects, 'args' );
79
            $class->_objects_cache_set($cache_key, $objects, 'args');
80
        }
80
        }
81
        return $objects;
81
        return $objects;
82
    }
82
    }
(-)a/Koha/Objects/Cached/Base.pm (-26 / +78 lines)
Lines 2-8 package Koha::Objects::Cached::Base; Link Here
2
2
3
use Modern::Perl;
3
use Modern::Perl;
4
use Digest::MD5 qw( md5_hex );
4
use Digest::MD5 qw( md5_hex );
5
use Carp qw( croak );
5
use Carp        qw( croak );
6
use JSON;
6
use JSON;
7
use Data::Dumper;
7
use Data::Dumper;
8
8
Lines 16-114 Koha::Objects::Cached::Base Link Here
16
16
17
=head3 _objects_cache_cache_key
17
=head3 _objects_cache_cache_key
18
18
19
my $cache_key = $self->_objects_cache_cache_key($method, @args);
20
21
Get the object/objects cache key for a particular method based on the method arguments.
22
23
=over 8
24
25
=item B<$method>
26
27
The current method, for example "find" or "search".
28
29
=item B<@args>
30
31
The method arguments.
32
33
=back
34
19
=cut
35
=cut
20
36
21
sub _objects_cache_cache_key {
37
sub _objects_cache_cache_key {
22
    my ($self, @args) = @_;
38
    my ( $self, @args ) = @_;
23
    if (@args == 2 && !ref $args[1]) {
39
    if ( @args == 2 && !ref $args[1] ) {
24
        return join(':', @args);
40
        return join( ':', @args );
25
    }
41
    }
42
26
    # JSON is much faster than Data::Dumper but throws
43
    # JSON is much faster than Data::Dumper but throws
27
    # an exception for certain perl data strucures
44
    # an exception for certain perl data structures
28
    # (non boolean scalar refs for example which can
45
    # (non boolean scalar refs for example which can
29
    # be used in DBIx conditions)
46
    # be used in DBIx conditions)
30
    my $cache_key = eval { md5_hex(JSON->new->canonical(1)->encode(\@args)) };
47
    my $cache_key = eval { md5_hex( JSON->new->canonical(1)->encode( \@args ) ) };
31
    if ($cache_key) {
48
    if ($cache_key) {
32
        return $cache_key;
49
        return $cache_key;
33
    } else {
50
    } else {
34
        local $Data::Dumper::Sortkeys = 1;
51
        local $Data::Dumper::Sortkeys = 1;
35
        return md5_hex(Dumper(\@args));
52
        return md5_hex( Dumper( \@args ) );
36
    }
53
    }
37
}
54
}
38
55
39
=head3 _objects_cache_bucket_key
56
=head3 _objects_cache_bucket_key
40
57
58
my $bucket_key = $self->_objects_cache_bucket_key($bucket);
59
60
Get the full cache bucket key of the short hand C<$bucket> name for this object type.
61
62
=over 8
63
64
=item B<$bucket>
65
66
The bucket name, "ids" for the bucket key where objects retrieved by ids are stored,
67
or "args" for the bucket key where objects retrieved by more complex conditions are
68
stored.
69
70
=back
71
41
=cut
72
=cut
42
73
43
sub _objects_cache_bucket_key {
74
sub _objects_cache_bucket_key {
44
    my ($self, $bucket) = @_;
75
    my ( $self, $bucket ) = @_;
45
    my %buckets = (
76
    my %buckets = (
46
        'ids' => 'ObjectsCachedIds',
77
        'ids'  => 'ObjectsCachedIds',
47
        'args' => 'ObjectsCachedArgs'
78
        'args' => 'ObjectsCachedArgs'
48
    );
79
    );
49
    unless (exists $buckets{$bucket}) {
80
    unless ( exists $buckets{$bucket} ) {
50
        croak "Invalid cache bucket $bucket";
81
        croak "Invalid cache bucket $bucket";
51
    }
82
    }
52
    return $self->_type . $buckets{$bucket};
83
    return $self->_type . $buckets{$bucket};
53
84
54
55
}
85
}
56
86
57
=head3 _objects_cache_bucket
87
=head3 _objects_cache_bucket
58
88
89
my $cache = _objects_cache_bucket($bucket);
90
91
Get the memory cache of the short hand C<$bucket> name for this object type.
92
93
=over 8
94
95
=item B<$bucket>
96
97
The bucket name, "ids" for the bucket key where objects retrieved by ids are stored,
98
or "args" for the bucket key where objects retrieved by more complex conditions are
99
stored.
100
101
=back
102
59
=cut
103
=cut
60
104
61
sub _objects_cache_bucket {
105
sub _objects_cache_bucket {
62
    my ($self, $bucket) = @_;
106
    my ( $self, $bucket ) = @_;
63
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
107
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
64
    my $bucket_key = $self->_objects_cache_bucket_key($bucket);
108
    my $bucket_key   = $self->_objects_cache_bucket_key($bucket);
65
    my $cache = $memory_cache->get_from_cache($bucket_key);
109
    my $cache        = $memory_cache->get_from_cache($bucket_key);
66
    unless ($cache) {
110
    unless ($cache) {
67
        $cache = {};
111
        $cache = {};
68
        $memory_cache->set_in_cache($bucket_key, $cache);
112
        $memory_cache->set_in_cache( $bucket_key, $cache );
69
    }
113
    }
70
    return $cache;
114
    return $cache;
71
}
115
}
72
116
73
=head3 _objects_cache_get
117
=head3 _objects_cache_get
74
118
119
my $objects = $self->_objects_cache_get($cache_key, $bucket);
120
121
Get the cached object or objects for the C<$cache_key> and C<$bucket>
122
75
=cut
123
=cut
76
124
77
sub _objects_cache_get {
125
sub _objects_cache_get {
78
    my ($self, $cache_key, $bucket) = @_;
126
    my ( $self, $cache_key, $bucket ) = @_;
79
    my $cache = $self->_objects_cache_bucket($bucket);
127
    my $cache = $self->_objects_cache_bucket($bucket);
80
    return exists $cache->{$cache_key} ? $cache->{$cache_key} : undef;
128
    return exists $cache->{$cache_key} ? $cache->{$cache_key} : undef;
81
}
129
}
82
130
83
=head3 _objects_cache_set
131
=head3 _objects_cache_set
84
132
133
$self->_objects_cache_set($cache_key, $bucket, $object);
134
135
Set the cached object or objects for the C<$cache_key> and C<$bucket>
136
85
=cut
137
=cut
86
138
87
sub _objects_cache_set {
139
sub _objects_cache_set {
88
    my ($self, $cache_key, $object, $bucket) = @_;
140
    my ( $self, $cache_key, $object, $bucket ) = @_;
89
    my $cache = $self->_objects_cache_bucket($bucket);
141
    my $cache = $self->_objects_cache_bucket($bucket);
90
    $cache->{$cache_key} = $object;
142
    $cache->{$cache_key} = $object;
91
}
143
}
92
144
93
=head3 _objects_cache_clear
145
=head3 _objects_cache_clear
94
146
147
$self->_objects_cache_clear($ids_cache_key);
148
149
Clear objects cache, if $ids_cache_key is provided only that
150
key will be purged from the 'ids' cache bucket.
151
95
=cut
152
=cut
96
153
97
sub _objects_cache_clear {
154
sub _objects_cache_clear {
98
    my ($self, $ids_cache_key) = @_;
155
    my ( $self, $ids_cache_key ) = @_;
99
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
156
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
100
    if ($ids_cache_key) {
157
    if ($ids_cache_key) {
101
        my $cache = $self->_objects_cache_bucket('ids');
158
        my $cache = $self->_objects_cache_bucket('ids');
102
        delete $cache->{$ids_cache_key};
159
        delete $cache->{$ids_cache_key};
160
    } else {
161
        $memory_cache->clear_from_cache( $self->_objects_cache_bucket_key('ids') );
103
    }
162
    }
104
    else {
163
    $memory_cache->clear_from_cache( $self->_objects_cache_bucket_key('args') );
105
        $memory_cache->clear_from_cache(
106
            $self->_objects_cache_bucket_key('ids')
107
        );
108
    }
109
    $memory_cache->clear_from_cache(
110
        $self->_objects_cache_bucket_key('args')
111
    );
112
}
164
}
113
165
114
=head1 AUTHOR
166
=head1 AUTHOR
(-)a/acqui/acqui-home.pl (-1 / +1 lines)
Lines 88-94 foreach my $budget ( @{$budget_arr} ) { Link Here
88
    next unless ( CanUserUseBudget( $loggedinpatron, $budget, $userflags ) );
88
    next unless ( CanUserUseBudget( $loggedinpatron, $budget, $userflags ) );
89
89
90
    if ( $budget->{budget_owner_id} ) {
90
    if ( $budget->{budget_owner_id} ) {
91
        $budget->{budget_owner} = Koha::Patrons->find($budget->{budget_owner_id});
91
        $budget->{budget_owner} = Koha::Patrons->find( $budget->{budget_owner_id} );
92
    }
92
    }
93
93
94
    if ( !defined $budget->{budget_amount} ) {
94
    if ( !defined $budget->{budget_amount} ) {
(-)a/t/db_dependent/Koha/Libraries.t (-57 / +58 lines)
Lines 517-533 subtest 'cache tests' => sub { Link Here
517
    my $library1 = $builder->build_object(
517
    my $library1 = $builder->build_object(
518
        {
518
        {
519
            class => 'Koha::Libraries',
519
            class => 'Koha::Libraries',
520
            value  => {
520
            value => { branchname => 'My library' }
521
                branchname => 'My library'
522
            }
523
        }
521
        }
524
    );
522
    );
525
    my $library2 = $builder->build_object(
523
    my $library2 = $builder->build_object(
526
        {
524
        {
527
            class => 'Koha::Libraries',
525
            class => 'Koha::Libraries',
528
            value  => {
526
            value => { branchname => 'My other library' }
529
                branchname => 'My other library'
530
            }
531
        }
527
        }
532
    );
528
    );
533
529
Lines 537-560 subtest 'cache tests' => sub { Link Here
537
    Koha::Cache::Memory::Lite->get_instance()->flush();
533
    Koha::Cache::Memory::Lite->get_instance()->flush();
538
534
539
    my $ids_bucket = Koha::Libraries->_objects_cache_bucket('ids');
535
    my $ids_bucket = Koha::Libraries->_objects_cache_bucket('ids');
540
    ok(!%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache');
536
    ok( !%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache' );
541
537
542
    my $cached_library = Koha::Libraries->find($library1->branchcode);
538
    my $cached_library = Koha::Libraries->find( $library1->branchcode );
543
    Koha::Libraries->find($library2->branchcode);
539
    Koha::Libraries->find( $library2->branchcode );
544
540
545
    my $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
541
    my $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
546
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
542
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
547
        'ids'
543
        'ids'
548
    );
544
    );
549
    is (ref($cached_library_ids_bucket), 'Koha::Library', 'Library should be cached after previously have been fetched');
545
    is(
550
    is ($cached_library_ids_bucket->branchcode, $library1->branchcode, 'The cashed library should be the expected library');
546
        ref($cached_library_ids_bucket), 'Koha::Library',
547
        'Library should be cached after previously have been fetched'
548
    );
549
    is(
550
        $cached_library_ids_bucket->branchcode, $library1->branchcode,
551
        'The cashed library should be the expected library'
552
    );
551
553
552
    # Set property of library by-passing the cache expiration logic
554
    # Set property of library by-passing the cache expiration logic
553
    # so we can veriy library is not only present in cache by also
555
    # so we can veriy library is not only present in cache by also
554
    # properly retrieved in find
556
    # properly retrieved in find
555
    $cached_library->_result->set_column('branchname', 'My library in cache');
557
    $cached_library->_result->set_column( 'branchname', 'My library in cache' );
556
    $cached_library = Koha::Libraries->find($library1->branchcode);
558
    $cached_library = Koha::Libraries->find( $library1->branchcode );
557
    is (
559
    is(
558
        $cached_library->branchname,
560
        $cached_library->branchname,
559
        'My library in cache',
561
        'My library in cache',
560
        'The cashed library returned by find should be the cached library'
562
        'The cashed library returned by find should be the cached library'
Lines 562-597 subtest 'cache tests' => sub { Link Here
562
564
563
    $library1->branchname('My expired library');
565
    $library1->branchname('My expired library');
564
    $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
566
    $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
565
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
567
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
566
        'ids'
568
        'ids'
567
    );
569
    );
568
    is (
570
    is(
569
        $cached_library_ids_bucket,
571
        $cached_library_ids_bucket,
570
        undef,
572
        undef,
571
        'Cache has been expired after changing library property'
573
        'Cache has been expired after changing library property'
572
    );
574
    );
573
575
574
    $cached_library = Koha::Libraries->_objects_cache_get(
576
    $cached_library = Koha::Libraries->_objects_cache_get(
575
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
577
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
576
        'ids'
578
        'ids'
577
    );
579
    );
578
    is (
580
    is(
579
        ref($cached_library),
581
        ref($cached_library),
580
        'Koha::Library', 'Cache should still contain other cached libraries'
582
        'Koha::Library', 'Cache should still contain other cached libraries'
581
    );
583
    );
582
584
583
    my $stored_library = Koha::Libraries->find($library1->branchcode);
585
    my $stored_library = Koha::Libraries->find( $library1->branchcode );
584
    is (
586
    is(
585
        $stored_library->branchname,
587
        $stored_library->branchname,
586
        'My library',
588
        'My library',
587
        'Library is fetched from database after cache has been expired'
589
        'Library is fetched from database after cache has been expired'
588
    );
590
    );
589
591
590
    $cached_library = Koha::Libraries->_objects_cache_get(
592
    $cached_library = Koha::Libraries->_objects_cache_get(
591
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
593
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
592
        'ids'
594
        'ids'
593
    );
595
    );
594
    is (
596
    is(
595
        ref($cached_library),
597
        ref($cached_library),
596
        'Koha::Library',
598
        'Koha::Library',
597
        'Library should be cached after previously have been fetched'
599
        'Library should be cached after previously have been fetched'
Lines 599-641 subtest 'cache tests' => sub { Link Here
599
601
600
    $library1->store();
602
    $library1->store();
601
    $cached_library = Koha::Libraries->_objects_cache_get(
603
    $cached_library = Koha::Libraries->_objects_cache_get(
602
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
604
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
603
        'ids'
605
        'ids'
604
    );
606
    );
605
    is ($cached_library, undef, 'Cache has been expired after saving library to database');
607
    is( $cached_library, undef, 'Cache has been expired after saving library to database' );
606
608
607
    Koha::Libraries->find($library1->branchcode, { key => 'primary' });
609
    Koha::Libraries->find( $library1->branchcode, { key => 'primary' } );
608
    $cached_library = Koha::Libraries->_objects_cache_get(
610
    $cached_library = Koha::Libraries->_objects_cache_get(
609
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode, { key => 'primary' }),
611
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode, { key => 'primary' } ),
610
        'args'
612
        'args'
611
    );
613
    );
612
    is (
614
    is(
613
        ref($cached_library),
615
        ref($cached_library),
614
        'Koha::Library',
616
        'Koha::Library',
615
        'The args cache bucket should be used if find is called with the attrs argument'
617
        'The args cache bucket should be used if find is called with the attrs argument'
616
    );
618
    );
617
    my $cached_value;
619
    my $cached_value;
618
620
619
    for my $method ('find', 'search') {
621
    for my $method ( 'find', 'search' ) {
620
622
621
        Koha::Libraries->$method({ branchcode => $library1->branchcode });
623
        Koha::Libraries->$method( { branchcode => $library1->branchcode } );
622
        Koha::Libraries->$method({ branchcode => $library2->branchcode });
624
        Koha::Libraries->$method( { branchcode => $library2->branchcode } );
623
625
624
        $cached_value = Koha::Libraries->_objects_cache_get(
626
        $cached_value = Koha::Libraries->_objects_cache_get(
625
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }),
627
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library1->branchcode } ),
626
            'args'
628
            'args'
627
        );
629
        );
628
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
630
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
629
        is (
631
        is(
630
            ref($cached_library),
632
            ref($cached_library),
631
            'Koha::Library',
633
            'Koha::Library',
632
            'Library should be cached after previously have been fetched, and use the args cache bucket ' . ($method eq 'find' ? 'if find was called with column conditions' : 'if search was called')
634
            'Library should be cached after previously have been fetched, and use the args cache bucket '
635
                . ( $method eq 'find' ? 'if find was called with column conditions' : 'if search was called' )
633
        );
636
        );
634
637
635
        $cached_library->_result->set_column('branchname', 'My library in cache');
638
        $cached_library->_result->set_column( 'branchname', 'My library in cache' );
636
        $cached_value = Koha::Libraries->$method({ branchcode => $library1->branchcode });
639
        $cached_value   = Koha::Libraries->$method( { branchcode => $library1->branchcode } );
637
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
640
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
638
        is (
641
        is(
639
            $cached_library->branchname,
642
            $cached_library->branchname,
640
            'My library in cache',
643
            'My library in cache',
641
            "The cashed library returned by $method should be the cached library, using the args cache bucket"
644
            "The cashed library returned by $method should be the cached library, using the args cache bucket"
Lines 643-683 subtest 'cache tests' => sub { Link Here
643
646
644
        $cached_library->branchname('My expired library');
647
        $cached_library->branchname('My expired library');
645
        $cached_value = Koha::Libraries->_objects_cache_get(
648
        $cached_value = Koha::Libraries->_objects_cache_get(
646
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }),
649
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library1->branchcode } ),
647
            'args'
650
            'args'
648
        );
651
        );
649
        is (
652
        is(
650
            $cached_value,
653
            $cached_value,
651
            undef,
654
            undef,
652
            'Cache has been expired after changing branchname, using the args cache bucket'
655
            'Cache has been expired after changing branchname, using the args cache bucket'
653
        );
656
        );
654
657
655
        $cached_value = Koha::Libraries->_objects_cache_get(
658
        $cached_value = Koha::Libraries->_objects_cache_get(
656
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library2->branchcode }),
659
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library2->branchcode } ),
657
            'args'
660
            'args'
658
        );
661
        );
659
        is (
662
        is(
660
            $cached_value,
663
            $cached_value,
661
            undef,
664
            undef,
662
            'The whole args cache bucket has been emptied after triggering cache expiration'
665
            'The whole args cache bucket has been emptied after triggering cache expiration'
663
        );
666
        );
664
    }
667
    }
665
668
666
    Koha::Libraries->find($library2->branchcode);
669
    Koha::Libraries->find( $library2->branchcode );
667
670
668
    my $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode });
671
    my $libraries = Koha::Libraries->search( { branchcode => $library1->branchcode } );
669
    $libraries->next;
672
    $libraries->next;
670
    is($libraries->next, undef, 'Cached libraries search result iterator has been exhausted');
673
    is( $libraries->next, undef, 'Cached libraries search result iterator has been exhausted' );
671
672
    $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode });
673
    is(ref($libraries->next), 'Koha::Library', 'Cached libraries search result iterator has been reset');
674
674
675
    $libraries = Koha::Libraries->search( { branchcode => $library1->branchcode } );
676
    is( ref( $libraries->next ), 'Koha::Library', 'Cached libraries search result iterator has been reset' );
675
677
676
    my $cached_libraries = Koha::Libraries->_objects_cache_get(
678
    my $cached_libraries = Koha::Libraries->_objects_cache_get(
677
        Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }),
679
        Koha::Libraries->_objects_cache_cache_key( 'search', { 'branchcode' => $library1->branchcode } ),
678
        'args'
680
        'args'
679
    );
681
    );
680
    is (
682
    is(
681
        ref($cached_libraries),
683
        ref($cached_libraries),
682
        'Koha::Libraries',
684
        'Koha::Libraries',
683
        'Libraries should be cached after previously have been fetched'
685
        'Libraries should be cached after previously have been fetched'
Lines 685-710 subtest 'cache tests' => sub { Link Here
685
687
686
    $library1->delete();
688
    $library1->delete();
687
    $cached_libraries = Koha::Libraries->_objects_cache_get(
689
    $cached_libraries = Koha::Libraries->_objects_cache_get(
688
        Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }),
690
        Koha::Libraries->_objects_cache_cache_key( 'search', { 'branchcode' => $library1->branchcode } ),
689
        'args'
691
        'args'
690
    );
692
    );
691
    is ($cached_libraries, undef, 'Search cache has been expired after deleting library');
693
    is( $cached_libraries, undef, 'Search cache has been expired after deleting library' );
692
694
693
    $cached_library = Koha::Libraries->_objects_cache_get(
695
    $cached_library = Koha::Libraries->_objects_cache_get(
694
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
696
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
695
        'ids'
697
        'ids'
696
    );
698
    );
697
    is (
699
    is(
698
        ref($cached_library),
700
        ref($cached_library),
699
        'Koha::Library',
701
        'Koha::Library',
700
        'Library should be cached after previously have been fetched'
702
        'Library should be cached after previously have been fetched'
701
    );
703
    );
702
    $library2->delete();
704
    $library2->delete();
703
    $cached_library = Koha::Libraries->_objects_cache_get(
705
    $cached_library = Koha::Libraries->_objects_cache_get(
704
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
706
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
705
        'ids'
707
        'ids'
706
    );
708
    );
707
    is ($cached_library, undef, 'Find cache has been expired after deleting library');
709
    is( $cached_library, undef, 'Find cache has been expired after deleting library' );
708
710
709
    $schema->storage->txn_rollback;
711
    $schema->storage->txn_rollback;
710
}
712
    }
711
- 

Return to bug 36350