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

(-)a/Koha/CachedFind/Base.pm (+107 lines)
Line 0 Link Here
1
package Koha::CachedFind::Base;
2
3
use Modern::Perl;
4
use Data::Dumper;
5
use Digest::MD5 qw( md5_hex );
6
use Carp qw( croak );
7
8
use Koha::Cache::Memory::Lite;
9
10
=head1 NAME
11
12
Koha::CachedFind::Base
13
14
=head2 Internal methods
15
16
=head3 _find_cache_cache_key
17
18
=cut
19
20
sub _find_cache_cache_key {
21
    my ($self, @args) = @_;
22
    local $Data::Dumper::Sortkeys = 1;
23
    return md5_hex(Dumper(\@args));
24
}
25
26
=head3 _find_cache_bucket_key
27
28
=cut
29
30
sub _find_cache_bucket_key {
31
    my ($self, $bucket) = @_;
32
    my %buckets = (
33
        'ids' => 'CachedFindIds',
34
        'args' => 'CachedFindArgs'
35
    );
36
    unless (exists $buckets{$bucket}) {
37
        croak "Invalid cache bucket $bucket";
38
    }
39
    return $self->_type . $buckets{$bucket};
40
41
42
}
43
44
=head3 _find_cache_bucket
45
46
=cut
47
48
sub _find_cache_bucket {
49
    my ($self, $bucket) = @_;
50
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
51
    my $bucket_key = $self->_find_cache_bucket_key($bucket);
52
    my $cache = $memory_cache->get_from_cache($bucket_key);
53
    unless ($cache) {
54
        $cache = {};
55
        $memory_cache->set_in_cache($bucket_key, $cache);
56
    }
57
    return $cache;
58
}
59
60
=head3 _find_cache_get
61
62
=cut
63
64
sub _find_cache_get {
65
    my ($self, $cache_key, $bucket) = @_;
66
    my $cache = $self->_find_cache_bucket($bucket);
67
    return exists $cache->{$cache_key} ? $cache->{$cache_key} : undef;
68
}
69
70
=head3 _find_cache_set
71
72
=cut
73
74
sub _find_cache_set {
75
    my ($self, $cache_key, $object, $bucket) = @_;
76
    my $cache = $self->_find_cache_bucket($bucket);
77
    $cache->{$cache_key} = $object;
78
}
79
80
=head3 _find_cache_clear
81
82
=cut
83
84
sub _find_cache_clear {
85
    my ($self, $cache_key) = @_;
86
    my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
87
    if ($cache_key) {
88
        my $cache = $self->_find_cache_bucket('ids');
89
        delete $cache->{$cache_key};
90
    }
91
    else {
92
        $memory_cache->clear_from_cache(
93
            $self->_find_cache_bucket_key('ids')
94
        );
95
    }
96
    $memory_cache->clear_from_cache(
97
        $self->_find_cache_bucket_key('args')
98
    );
99
}
100
101
=head1 AUTHOR
102
103
David Gustafsson <david.gustafsson@ub.gu.se>
104
105
=cut
106
107
1;
(-)a/Koha/ItemType.pm (-1 / +1 lines)
Lines 24-30 use Koha::Database; Link Here
24
use Koha::CirculationRules;
24
use Koha::CirculationRules;
25
use Koha::Localizations;
25
use Koha::Localizations;
26
26
27
use base qw(Koha::Object Koha::Object::Limit::Library);
27
use base qw(Koha::Object::CachedFindExpiration Koha::Object::Limit::Library);
28
28
29
my $cache = Koha::Caches->get_instance();
29
my $cache = Koha::Caches->get_instance();
30
30
(-)a/Koha/ItemTypes.pm (-1 / +1 lines)
Lines 23-29 use C4::Languages; Link Here
23
use Koha::Database;
23
use Koha::Database;
24
use Koha::ItemType;
24
use Koha::ItemType;
25
25
26
use base qw(Koha::Objects Koha::Objects::Limit::Library);
26
use base qw(Koha::Objects::CachedFind Koha::Objects::Limit::Library);
27
27
28
=head1 NAME
28
=head1 NAME
29
29
(-)a/Koha/Libraries.pm (-1 / +1 lines)
Lines 29-35 use Koha::Items; Link Here
29
use Koha::Library;
29
use Koha::Library;
30
use Koha::Patrons;
30
use Koha::Patrons;
31
31
32
use base qw(Koha::Objects);
32
use base qw(Koha::Objects::CachedFind);
33
33
34
=head1 NAME
34
=head1 NAME
35
35
(-)a/Koha/Library.pm (-1 / +1 lines)
Lines 27-33 use Koha::Database; Link Here
27
use Koha::StockRotationStages;
27
use Koha::StockRotationStages;
28
use Koha::SMTP::Servers;
28
use Koha::SMTP::Servers;
29
29
30
use base qw(Koha::Object);
30
use base qw(Koha::Object::CachedFindExpiration);
31
31
32
my $cache = Koha::Caches->get_instance();
32
my $cache = Koha::Caches->get_instance();
33
33
(-)a/Koha/Object.pm (+3 lines)
Lines 945-950 sub AUTOLOAD { Link Here
945
        my $accessor = sub {
945
        my $accessor = sub {
946
            my $self = shift;
946
            my $self = shift;
947
            if (@_) {
947
            if (@_) {
948
                if ($self->isa("Koha::Object::CachedFindExpiration")) {
949
                    $self->_find_cache_expire();
950
                }
948
                $self->_result()->set_column( $method, @_ );
951
                $self->_result()->set_column( $method, @_ );
949
                return $self;
952
                return $self;
950
            } else {
953
            } else {
(-)a/Koha/Object/CachedFindExpiration.pm (+66 lines)
Line 0 Link Here
1
package Koha::Object::CachedFindExpiration;
2
3
use parent qw( Koha::Object Koha::CachedFind::Base );
4
use Modern::Perl;
5
use Data::Dumper;
6
7
=head1 NAME
8
9
Koha::Object::CachedFindExpiration
10
11
=head1 SYNOPSIS
12
13
    package Koha::Foo;
14
15
    use parent qw( Koha::Object::CachedFindExpiration );
16
17
=head1 API
18
19
=head2 Class Methods
20
21
=cut
22
23
=head3 delete
24
25
Overloaded I<delete> method for cache expiration
26
27
=cut
28
29
sub delete {
30
    my ($self) = @_;
31
    $self->_find_cache_expire();
32
    $self->SUPER::delete();
33
}
34
35
=head3 delete
36
37
Overloaded I<store> method for cache expiration
38
39
=cut
40
41
sub store {
42
    my ($self) = @_;
43
    $self->_find_cache_expire();
44
    $self->SUPER::store();
45
}
46
47
=head2 Internal methods
48
49
=head3 _find_cache_expire
50
51
=cut
52
53
sub _find_cache_expire {
54
    my ($self) = @_;
55
    my @primary_keys = $self->_result->id;
56
    my $cache_key = $self->_find_cache_cache_key(@primary_keys);
57
    $self->_find_cache_clear($cache_key);
58
}
59
60
=head1 AUTHOR
61
62
David Gustafsson <david.gustafsson@ub.gu.se>
63
64
=cut
65
66
1;
(-)a/Koha/Objects/CachedFind.pm (+58 lines)
Line 0 Link Here
1
package Koha::Objects::CachedFind;
2
3
use parent qw( Koha::Objects Koha::CachedFind::Base );
4
use Modern::Perl;
5
6
=head1 NAME
7
8
Koha::Object::CachedFind
9
10
=head1 SYNOPSIS
11
12
    package Koha::Foo;
13
14
    use parent qw( Koha:Objects::CachedFind );
15
16
=head1 API
17
18
=head2 Class Methods
19
20
=cut
21
22
=head3 find
23
24
Overloaded I<find> method that provides in memory caching by arguments.
25
26
=cut
27
28
sub find {
29
    my ($class, @args) = @_;
30
    my $object;
31
    my $cache_key = $class->_find_cache_cache_key(@args);
32
33
    # Stor in the args bucket if has column value condiditions
34
    # or for some reason the attributes argument is provided
35
    if (ref $args[0] eq 'HASH' || @args > 1 && ref $args[$#args] eq 'HASH') {
36
        $object = $class->_find_cache_get($cache_key, 'args');
37
        unless ($object) {
38
            $object = $class->SUPER::find(@args);
39
            $class->_find_cache_set($cache_key, $object, 'args');
40
        }
41
    }
42
    else {
43
        $object = $class->_find_cache_get($cache_key, 'ids');
44
        unless ($object) {
45
            $object = $class->SUPER::find(@args);
46
            $class->_find_cache_set($cache_key, $object, 'ids');
47
        }
48
    }
49
    return $object;
50
}
51
52
=head1 AUTHOR
53
54
David Gustafsson <david.gustafsson@ub.gu.se>
55
56
=cut
57
58
1;
(-)a/t/db_dependent/Koha/Libraries.t (-2 / +141 lines)
Lines 19-25 Link Here
19
19
20
use Modern::Perl;
20
use Modern::Perl;
21
21
22
use Test::More tests => 13;
22
use Test::More tests => 14;
23
23
24
use C4::Biblio;
24
use C4::Biblio;
25
use C4::Context;
25
use C4::Context;
Lines 32-37 use Koha::Library; Link Here
32
use Koha::Libraries;
32
use Koha::Libraries;
33
use Koha::Database;
33
use Koha::Database;
34
use Koha::CirculationRules;
34
use Koha::CirculationRules;
35
use Koha::Cache::Memory::Lite;
35
36
36
use t::lib::Mocks;
37
use t::lib::Mocks;
37
use t::lib::TestBuilder;
38
use t::lib::TestBuilder;
Lines 413-415 subtest 'outgoing_transfers' => sub { Link Here
413
414
414
    $schema->storage->txn_rollback;
415
    $schema->storage->txn_rollback;
415
};
416
};
416
- 
417
418
subtest 'find cache tests' => sub {
419
    plan tests => 15;
420
421
    $schema->storage->txn_begin;
422
423
    my $library1 = $builder->build_object(
424
        {
425
            class => 'Koha::Libraries',
426
            value  => {
427
                branchname => 'My library'
428
            }
429
        }
430
    );
431
    my $library2 = $builder->build_object(
432
        {
433
            class => 'Koha::Libraries',
434
            value  => {
435
                branchname => 'My other library'
436
            }
437
        }
438
    );
439
440
    # Since build_object calls find internally
441
    # we first have to flush the cache since these
442
    # objects are now already cached
443
    Koha::Cache::Memory::Lite->get_instance()->flush();
444
445
    my $ids_bucket = Koha::Libraries->_find_cache_bucket('ids');
446
    ok(!%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache');
447
448
    my $cached_library = Koha::Libraries->find($library1->branchcode);
449
    Koha::Libraries->find($library2->branchcode);
450
451
    my $cached_library_ids_bucket = Koha::Libraries->_find_cache_get(
452
        Koha::Libraries->_find_cache_cache_key($library1->branchcode),
453
        'ids'
454
    );
455
    is (ref($cached_library_ids_bucket), 'Koha::Library', 'Library should be cached after previously have been fetched');
456
    is ($cached_library_ids_bucket->branchcode, $library1->branchcode, 'The cashed library should be the expected library');
457
458
    # Set property of library by-passing the cache expiration logic
459
    # so we can veriy library is not only present in cache by also
460
    # properly retrieved in find
461
    $cached_library->_result->set_column('branchname', 'My library test');
462
    $cached_library = Koha::Libraries->find($library1->branchcode);
463
    is ($cached_library->branchname, 'My library test', 'The cashed library returned by find should be the cached library');
464
465
    $library1->branchname('New branchname');
466
    $cached_library_ids_bucket = Koha::Libraries->_find_cache_get(
467
        Koha::Libraries->_find_cache_cache_key($library1->branchcode),
468
        'ids'
469
    );
470
    is ($cached_library_ids_bucket, undef, 'Cache has been expired after changing library property');
471
472
    $cached_library = Koha::Libraries->_find_cache_get(
473
        Koha::Libraries->_find_cache_cache_key($library2->branchcode),
474
        'ids'
475
    );
476
    is (ref($cached_library), 'Koha::Library', 'Cache should still contain other cached libraries');
477
478
    my $stored_library = Koha::Libraries->find($library1->branchcode);
479
    is ($stored_library->branchname, 'My library', 'Library is fetched from database after cache has been expired');
480
481
    $cached_library = Koha::Libraries->_find_cache_get(
482
        Koha::Libraries->_find_cache_cache_key($library1->branchcode),
483
        'ids'
484
    );
485
    is (ref($cached_library), 'Koha::Library', 'Library should be cached after previously have been fetched');
486
487
    $library1->store();
488
    $cached_library = Koha::Libraries->_find_cache_get(
489
        Koha::Libraries->_find_cache_cache_key($library1->branchcode),
490
        'ids'
491
    );
492
    is ($cached_library, undef, 'Cache has been expired after saving library to database');
493
494
    Koha::Libraries->find({ branchcode => $library1->branchcode });
495
    Koha::Libraries->find({ branchcode => $library2->branchcode });
496
497
    $cached_library = Koha::Libraries->_find_cache_get(
498
        Koha::Libraries->_find_cache_cache_key({ branchcode => $library1->branchcode }),
499
        'args'
500
    );
501
    is (
502
        ref($cached_library),
503
        'Koha::Library',
504
        'Library should be cached after previously have been fetched, and use the args cache bucket if find was called with column conditions'
505
    );
506
507
    $cached_library->_result->set_column('branchname', 'My library test');
508
    $cached_library = Koha::Libraries->find({ branchcode => $library1->branchcode });
509
    is (
510
        $cached_library->branchname,
511
        'My library test',
512
        'The cashed library returned by find should be the cached library, using the args cache bucket'
513
    );
514
515
    $cached_library->branchname('Some other branchname');
516
    $cached_library = Koha::Libraries->_find_cache_get(
517
        Koha::Libraries->_find_cache_cache_key({ branchcode => $library1->branchcode }),
518
        'args'
519
    );
520
    is (
521
        $cached_library,
522
        undef,
523
        'Cache has been expired after changing branchname, using the args cache bucket'
524
    );
525
526
    $cached_library = Koha::Libraries->_find_cache_get(
527
        Koha::Libraries->_find_cache_cache_key({ branchcode => $library2->branchcode }),
528
        'args'
529
    );
530
    is (
531
        $cached_library,
532
        undef,
533
        'The whole args cache bucket has been emptied after triggering cache expiration'
534
    );
535
536
    Koha::Libraries->find($library1->branchcode, { key => 'primary' });
537
    $cached_library = Koha::Libraries->_find_cache_get(
538
        Koha::Libraries->_find_cache_cache_key($library1->branchcode, { key => 'primary' }),
539
        'args'
540
    );
541
    is (
542
        ref($cached_library),
543
        'Koha::Library',
544
        'The args cache bucket should be used if find is called with the attrs argument'
545
    );
546
547
    $library1->delete();
548
    $cached_library = Koha::Libraries->_find_cache_get(
549
        Koha::Libraries->_find_cache_cache_key($library1->branchcode, { key => 'primary' }),
550
        'args'
551
    );
552
    is ($cached_library, undef, 'Cache has been expired after deleting library');
553
554
    $schema->storage->txn_rollback;
555
}

Return to bug 36350