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 516-532 subtest 'cache tests' => sub { Link Here
516
    my $library1 = $builder->build_object(
516
    my $library1 = $builder->build_object(
517
        {
517
        {
518
            class => 'Koha::Libraries',
518
            class => 'Koha::Libraries',
519
            value  => {
519
            value => { branchname => 'My library' }
520
                branchname => 'My library'
521
            }
522
        }
520
        }
523
    );
521
    );
524
    my $library2 = $builder->build_object(
522
    my $library2 = $builder->build_object(
525
        {
523
        {
526
            class => 'Koha::Libraries',
524
            class => 'Koha::Libraries',
527
            value  => {
525
            value => { branchname => 'My other library' }
528
                branchname => 'My other library'
529
            }
530
        }
526
        }
531
    );
527
    );
532
528
Lines 536-559 subtest 'cache tests' => sub { Link Here
536
    Koha::Cache::Memory::Lite->get_instance()->flush();
532
    Koha::Cache::Memory::Lite->get_instance()->flush();
537
533
538
    my $ids_bucket = Koha::Libraries->_objects_cache_bucket('ids');
534
    my $ids_bucket = Koha::Libraries->_objects_cache_bucket('ids');
539
    ok(!%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache');
535
    ok( !%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache' );
540
536
541
    my $cached_library = Koha::Libraries->find($library1->branchcode);
537
    my $cached_library = Koha::Libraries->find( $library1->branchcode );
542
    Koha::Libraries->find($library2->branchcode);
538
    Koha::Libraries->find( $library2->branchcode );
543
539
544
    my $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
540
    my $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
545
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
541
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
546
        'ids'
542
        'ids'
547
    );
543
    );
548
    is (ref($cached_library_ids_bucket), 'Koha::Library', 'Library should be cached after previously have been fetched');
544
    is(
549
    is ($cached_library_ids_bucket->branchcode, $library1->branchcode, 'The cashed library should be the expected library');
545
        ref($cached_library_ids_bucket), 'Koha::Library',
546
        'Library should be cached after previously have been fetched'
547
    );
548
    is(
549
        $cached_library_ids_bucket->branchcode, $library1->branchcode,
550
        'The cashed library should be the expected library'
551
    );
550
552
551
    # Set property of library by-passing the cache expiration logic
553
    # Set property of library by-passing the cache expiration logic
552
    # so we can veriy library is not only present in cache by also
554
    # so we can veriy library is not only present in cache by also
553
    # properly retrieved in find
555
    # properly retrieved in find
554
    $cached_library->_result->set_column('branchname', 'My library in cache');
556
    $cached_library->_result->set_column( 'branchname', 'My library in cache' );
555
    $cached_library = Koha::Libraries->find($library1->branchcode);
557
    $cached_library = Koha::Libraries->find( $library1->branchcode );
556
    is (
558
    is(
557
        $cached_library->branchname,
559
        $cached_library->branchname,
558
        'My library in cache',
560
        'My library in cache',
559
        'The cashed library returned by find should be the cached library'
561
        'The cashed library returned by find should be the cached library'
Lines 561-596 subtest 'cache tests' => sub { Link Here
561
563
562
    $library1->branchname('My expired library');
564
    $library1->branchname('My expired library');
563
    $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
565
    $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get(
564
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
566
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
565
        'ids'
567
        'ids'
566
    );
568
    );
567
    is (
569
    is(
568
        $cached_library_ids_bucket,
570
        $cached_library_ids_bucket,
569
        undef,
571
        undef,
570
        'Cache has been expired after changing library property'
572
        'Cache has been expired after changing library property'
571
    );
573
    );
572
574
573
    $cached_library = Koha::Libraries->_objects_cache_get(
575
    $cached_library = Koha::Libraries->_objects_cache_get(
574
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
576
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
575
        'ids'
577
        'ids'
576
    );
578
    );
577
    is (
579
    is(
578
        ref($cached_library),
580
        ref($cached_library),
579
        'Koha::Library', 'Cache should still contain other cached libraries'
581
        'Koha::Library', 'Cache should still contain other cached libraries'
580
    );
582
    );
581
583
582
    my $stored_library = Koha::Libraries->find($library1->branchcode);
584
    my $stored_library = Koha::Libraries->find( $library1->branchcode );
583
    is (
585
    is(
584
        $stored_library->branchname,
586
        $stored_library->branchname,
585
        'My library',
587
        'My library',
586
        'Library is fetched from database after cache has been expired'
588
        'Library is fetched from database after cache has been expired'
587
    );
589
    );
588
590
589
    $cached_library = Koha::Libraries->_objects_cache_get(
591
    $cached_library = Koha::Libraries->_objects_cache_get(
590
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
592
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
591
        'ids'
593
        'ids'
592
    );
594
    );
593
    is (
595
    is(
594
        ref($cached_library),
596
        ref($cached_library),
595
        'Koha::Library',
597
        'Koha::Library',
596
        'Library should be cached after previously have been fetched'
598
        'Library should be cached after previously have been fetched'
Lines 598-640 subtest 'cache tests' => sub { Link Here
598
600
599
    $library1->store();
601
    $library1->store();
600
    $cached_library = Koha::Libraries->_objects_cache_get(
602
    $cached_library = Koha::Libraries->_objects_cache_get(
601
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode),
603
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode ),
602
        'ids'
604
        'ids'
603
    );
605
    );
604
    is ($cached_library, undef, 'Cache has been expired after saving library to database');
606
    is( $cached_library, undef, 'Cache has been expired after saving library to database' );
605
607
606
    Koha::Libraries->find($library1->branchcode, { key => 'primary' });
608
    Koha::Libraries->find( $library1->branchcode, { key => 'primary' } );
607
    $cached_library = Koha::Libraries->_objects_cache_get(
609
    $cached_library = Koha::Libraries->_objects_cache_get(
608
        Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode, { key => 'primary' }),
610
        Koha::Libraries->_objects_cache_cache_key( 'find', $library1->branchcode, { key => 'primary' } ),
609
        'args'
611
        'args'
610
    );
612
    );
611
    is (
613
    is(
612
        ref($cached_library),
614
        ref($cached_library),
613
        'Koha::Library',
615
        'Koha::Library',
614
        'The args cache bucket should be used if find is called with the attrs argument'
616
        'The args cache bucket should be used if find is called with the attrs argument'
615
    );
617
    );
616
    my $cached_value;
618
    my $cached_value;
617
619
618
    for my $method ('find', 'search') {
620
    for my $method ( 'find', 'search' ) {
619
621
620
        Koha::Libraries->$method({ branchcode => $library1->branchcode });
622
        Koha::Libraries->$method( { branchcode => $library1->branchcode } );
621
        Koha::Libraries->$method({ branchcode => $library2->branchcode });
623
        Koha::Libraries->$method( { branchcode => $library2->branchcode } );
622
624
623
        $cached_value = Koha::Libraries->_objects_cache_get(
625
        $cached_value = Koha::Libraries->_objects_cache_get(
624
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }),
626
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library1->branchcode } ),
625
            'args'
627
            'args'
626
        );
628
        );
627
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
629
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
628
        is (
630
        is(
629
            ref($cached_library),
631
            ref($cached_library),
630
            'Koha::Library',
632
            'Koha::Library',
631
            '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')
633
            'Library should be cached after previously have been fetched, and use the args cache bucket '
634
                . ( $method eq 'find' ? 'if find was called with column conditions' : 'if search was called' )
632
        );
635
        );
633
636
634
        $cached_library->_result->set_column('branchname', 'My library in cache');
637
        $cached_library->_result->set_column( 'branchname', 'My library in cache' );
635
        $cached_value = Koha::Libraries->$method({ branchcode => $library1->branchcode });
638
        $cached_value   = Koha::Libraries->$method( { branchcode => $library1->branchcode } );
636
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
639
        $cached_library = $method eq 'search' ? $cached_value->next : $cached_value;
637
        is (
640
        is(
638
            $cached_library->branchname,
641
            $cached_library->branchname,
639
            'My library in cache',
642
            'My library in cache',
640
            "The cashed library returned by $method should be the cached library, using the args cache bucket"
643
            "The cashed library returned by $method should be the cached library, using the args cache bucket"
Lines 642-682 subtest 'cache tests' => sub { Link Here
642
645
643
        $cached_library->branchname('My expired library');
646
        $cached_library->branchname('My expired library');
644
        $cached_value = Koha::Libraries->_objects_cache_get(
647
        $cached_value = Koha::Libraries->_objects_cache_get(
645
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }),
648
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library1->branchcode } ),
646
            'args'
649
            'args'
647
        );
650
        );
648
        is (
651
        is(
649
            $cached_value,
652
            $cached_value,
650
            undef,
653
            undef,
651
            'Cache has been expired after changing branchname, using the args cache bucket'
654
            'Cache has been expired after changing branchname, using the args cache bucket'
652
        );
655
        );
653
656
654
        $cached_value = Koha::Libraries->_objects_cache_get(
657
        $cached_value = Koha::Libraries->_objects_cache_get(
655
            Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library2->branchcode }),
658
            Koha::Libraries->_objects_cache_cache_key( $method, { branchcode => $library2->branchcode } ),
656
            'args'
659
            'args'
657
        );
660
        );
658
        is (
661
        is(
659
            $cached_value,
662
            $cached_value,
660
            undef,
663
            undef,
661
            'The whole args cache bucket has been emptied after triggering cache expiration'
664
            'The whole args cache bucket has been emptied after triggering cache expiration'
662
        );
665
        );
663
    }
666
    }
664
667
665
    Koha::Libraries->find($library2->branchcode);
668
    Koha::Libraries->find( $library2->branchcode );
666
669
667
    my $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode });
670
    my $libraries = Koha::Libraries->search( { branchcode => $library1->branchcode } );
668
    $libraries->next;
671
    $libraries->next;
669
    is($libraries->next, undef, 'Cached libraries search result iterator has been exhausted');
672
    is( $libraries->next, undef, 'Cached libraries search result iterator has been exhausted' );
670
671
    $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode });
672
    is(ref($libraries->next), 'Koha::Library', 'Cached libraries search result iterator has been reset');
673
673
674
    $libraries = Koha::Libraries->search( { branchcode => $library1->branchcode } );
675
    is( ref( $libraries->next ), 'Koha::Library', 'Cached libraries search result iterator has been reset' );
674
676
675
    my $cached_libraries = Koha::Libraries->_objects_cache_get(
677
    my $cached_libraries = Koha::Libraries->_objects_cache_get(
676
        Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }),
678
        Koha::Libraries->_objects_cache_cache_key( 'search', { 'branchcode' => $library1->branchcode } ),
677
        'args'
679
        'args'
678
    );
680
    );
679
    is (
681
    is(
680
        ref($cached_libraries),
682
        ref($cached_libraries),
681
        'Koha::Libraries',
683
        'Koha::Libraries',
682
        'Libraries should be cached after previously have been fetched'
684
        'Libraries should be cached after previously have been fetched'
Lines 684-709 subtest 'cache tests' => sub { Link Here
684
686
685
    $library1->delete();
687
    $library1->delete();
686
    $cached_libraries = Koha::Libraries->_objects_cache_get(
688
    $cached_libraries = Koha::Libraries->_objects_cache_get(
687
        Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }),
689
        Koha::Libraries->_objects_cache_cache_key( 'search', { 'branchcode' => $library1->branchcode } ),
688
        'args'
690
        'args'
689
    );
691
    );
690
    is ($cached_libraries, undef, 'Search cache has been expired after deleting library');
692
    is( $cached_libraries, undef, 'Search cache has been expired after deleting library' );
691
693
692
    $cached_library = Koha::Libraries->_objects_cache_get(
694
    $cached_library = Koha::Libraries->_objects_cache_get(
693
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
695
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
694
        'ids'
696
        'ids'
695
    );
697
    );
696
    is (
698
    is(
697
        ref($cached_library),
699
        ref($cached_library),
698
        'Koha::Library',
700
        'Koha::Library',
699
        'Library should be cached after previously have been fetched'
701
        'Library should be cached after previously have been fetched'
700
    );
702
    );
701
    $library2->delete();
703
    $library2->delete();
702
    $cached_library = Koha::Libraries->_objects_cache_get(
704
    $cached_library = Koha::Libraries->_objects_cache_get(
703
        Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode),
705
        Koha::Libraries->_objects_cache_cache_key( 'find', $library2->branchcode ),
704
        'ids'
706
        'ids'
705
    );
707
    );
706
    is ($cached_library, undef, 'Find cache has been expired after deleting library');
708
    is( $cached_library, undef, 'Find cache has been expired after deleting library' );
707
709
708
    $schema->storage->txn_rollback;
710
    $schema->storage->txn_rollback;
709
}
711
    }
710
- 

Return to bug 36350