From 3cb95a8d52c85917222cc47f4a23d27c2c006739 Mon Sep 17 00:00:00 2001 From: David Gustafsson Date: Fri, 15 Mar 2024 21:12:33 +0100 Subject: [PATCH] Bug 36350: Add caching for Objects::find Add subclass of Koha::Objects that provides caching for find. To test: 1) Ensure tests in t/db_dependend/Koha/Libraries.t passes Sponsored-by: Gothenburg University Library --- Koha/CachedFind/Base.pm | 107 +++++++++++++++++++++ Koha/ItemType.pm | 2 +- Koha/ItemTypes.pm | 2 +- Koha/Libraries.pm | 2 +- Koha/Library.pm | 2 +- Koha/Object.pm | 3 + Koha/Object/CachedFindExpiration.pm | 66 +++++++++++++ Koha/Objects/CachedFind.pm | 58 ++++++++++++ t/db_dependent/Koha/Libraries.t | 142 +++++++++++++++++++++++++++- 9 files changed, 379 insertions(+), 5 deletions(-) create mode 100644 Koha/CachedFind/Base.pm create mode 100644 Koha/Object/CachedFindExpiration.pm create mode 100644 Koha/Objects/CachedFind.pm diff --git a/Koha/CachedFind/Base.pm b/Koha/CachedFind/Base.pm new file mode 100644 index 00000000000..03ea33a6bb6 --- /dev/null +++ b/Koha/CachedFind/Base.pm @@ -0,0 +1,107 @@ +package Koha::CachedFind::Base; + +use Modern::Perl; +use Data::Dumper; +use Digest::MD5 qw( md5_hex ); +use Carp qw( croak ); + +use Koha::Cache::Memory::Lite; + +=head1 NAME + +Koha::CachedFind::Base + +=head2 Internal methods + +=head3 _find_cache_cache_key + +=cut + +sub _find_cache_cache_key { + my ($self, @args) = @_; + local $Data::Dumper::Sortkeys = 1; + return md5_hex(Dumper(\@args)); +} + +=head3 _find_cache_bucket_key + +=cut + +sub _find_cache_bucket_key { + my ($self, $bucket) = @_; + my %buckets = ( + 'ids' => 'CachedFindIds', + 'args' => 'CachedFindArgs' + ); + unless (exists $buckets{$bucket}) { + croak "Invalid cache bucket $bucket"; + } + return $self->_type . $buckets{$bucket}; + + +} + +=head3 _find_cache_bucket + +=cut + +sub _find_cache_bucket { + my ($self, $bucket) = @_; + my $memory_cache = Koha::Cache::Memory::Lite->get_instance(); + my $bucket_key = $self->_find_cache_bucket_key($bucket); + my $cache = $memory_cache->get_from_cache($bucket_key); + unless ($cache) { + $cache = {}; + $memory_cache->set_in_cache($bucket_key, $cache); + } + return $cache; +} + +=head3 _find_cache_get + +=cut + +sub _find_cache_get { + my ($self, $cache_key, $bucket) = @_; + my $cache = $self->_find_cache_bucket($bucket); + return exists $cache->{$cache_key} ? $cache->{$cache_key} : undef; +} + +=head3 _find_cache_set + +=cut + +sub _find_cache_set { + my ($self, $cache_key, $object, $bucket) = @_; + my $cache = $self->_find_cache_bucket($bucket); + $cache->{$cache_key} = $object; +} + +=head3 _find_cache_clear + +=cut + +sub _find_cache_clear { + my ($self, $cache_key) = @_; + my $memory_cache = Koha::Cache::Memory::Lite->get_instance(); + if ($cache_key) { + my $cache = $self->_find_cache_bucket('ids'); + delete $cache->{$cache_key}; + } + else { + $memory_cache->clear_from_cache( + $self->_find_cache_bucket_key('ids') + ); + } + $memory_cache->clear_from_cache( + $self->_find_cache_bucket_key('args') + ); +} + +=head1 AUTHOR + +David Gustafsson + +=cut + +1; diff --git a/Koha/ItemType.pm b/Koha/ItemType.pm index fb88518c257..9c4aaf8a10c 100644 --- a/Koha/ItemType.pm +++ b/Koha/ItemType.pm @@ -24,7 +24,7 @@ use Koha::Database; use Koha::CirculationRules; use Koha::Localizations; -use base qw(Koha::Object Koha::Object::Limit::Library); +use base qw(Koha::Object::CachedFindExpiration Koha::Object::Limit::Library); my $cache = Koha::Caches->get_instance(); diff --git a/Koha/ItemTypes.pm b/Koha/ItemTypes.pm index 13caa648a81..306563fd927 100644 --- a/Koha/ItemTypes.pm +++ b/Koha/ItemTypes.pm @@ -23,7 +23,7 @@ use C4::Languages; use Koha::Database; use Koha::ItemType; -use base qw(Koha::Objects Koha::Objects::Limit::Library); +use base qw(Koha::Objects::CachedFind Koha::Objects::Limit::Library); =head1 NAME diff --git a/Koha/Libraries.pm b/Koha/Libraries.pm index 20ceb8aa348..b2edb987547 100644 --- a/Koha/Libraries.pm +++ b/Koha/Libraries.pm @@ -29,7 +29,7 @@ use Koha::Items; use Koha::Library; use Koha::Patrons; -use base qw(Koha::Objects); +use base qw(Koha::Objects::CachedFind); =head1 NAME diff --git a/Koha/Library.pm b/Koha/Library.pm index decfa136170..49511af7d70 100644 --- a/Koha/Library.pm +++ b/Koha/Library.pm @@ -27,7 +27,7 @@ use Koha::Database; use Koha::StockRotationStages; use Koha::SMTP::Servers; -use base qw(Koha::Object); +use base qw(Koha::Object::CachedFindExpiration); my $cache = Koha::Caches->get_instance(); diff --git a/Koha/Object.pm b/Koha/Object.pm index 560dccaff25..5efc0909d4e 100644 --- a/Koha/Object.pm +++ b/Koha/Object.pm @@ -945,6 +945,9 @@ sub AUTOLOAD { my $accessor = sub { my $self = shift; if (@_) { + if ($self->isa("Koha::Object::CachedFindExpiration")) { + $self->_find_cache_expire(); + } $self->_result()->set_column( $method, @_ ); return $self; } else { diff --git a/Koha/Object/CachedFindExpiration.pm b/Koha/Object/CachedFindExpiration.pm new file mode 100644 index 00000000000..000b5291010 --- /dev/null +++ b/Koha/Object/CachedFindExpiration.pm @@ -0,0 +1,66 @@ +package Koha::Object::CachedFindExpiration; + +use parent qw( Koha::Object Koha::CachedFind::Base ); +use Modern::Perl; +use Data::Dumper; + +=head1 NAME + +Koha::Object::CachedFindExpiration + +=head1 SYNOPSIS + + package Koha::Foo; + + use parent qw( Koha::Object::CachedFindExpiration ); + +=head1 API + +=head2 Class Methods + +=cut + +=head3 delete + +Overloaded I method for cache expiration + +=cut + +sub delete { + my ($self) = @_; + $self->_find_cache_expire(); + $self->SUPER::delete(); +} + +=head3 delete + +Overloaded I method for cache expiration + +=cut + +sub store { + my ($self) = @_; + $self->_find_cache_expire(); + $self->SUPER::store(); +} + +=head2 Internal methods + +=head3 _find_cache_expire + +=cut + +sub _find_cache_expire { + my ($self) = @_; + my @primary_keys = $self->_result->id; + my $cache_key = $self->_find_cache_cache_key(@primary_keys); + $self->_find_cache_clear($cache_key); +} + +=head1 AUTHOR + +David Gustafsson + +=cut + +1; diff --git a/Koha/Objects/CachedFind.pm b/Koha/Objects/CachedFind.pm new file mode 100644 index 00000000000..0539142f798 --- /dev/null +++ b/Koha/Objects/CachedFind.pm @@ -0,0 +1,58 @@ +package Koha::Objects::CachedFind; + +use parent qw( Koha::Objects Koha::CachedFind::Base ); +use Modern::Perl; + +=head1 NAME + +Koha::Object::CachedFind + +=head1 SYNOPSIS + + package Koha::Foo; + + use parent qw( Koha:Objects::CachedFind ); + +=head1 API + +=head2 Class Methods + +=cut + +=head3 find + +Overloaded I method that provides in memory caching by arguments. + +=cut + +sub find { + my ($class, @args) = @_; + my $object; + my $cache_key = $class->_find_cache_cache_key(@args); + + # Stor in the args bucket if has column value condiditions + # or for some reason the attributes argument is provided + if (ref $args[0] eq 'HASH' || @args > 1 && ref $args[$#args] eq 'HASH') { + $object = $class->_find_cache_get($cache_key, 'args'); + unless ($object) { + $object = $class->SUPER::find(@args); + $class->_find_cache_set($cache_key, $object, 'args'); + } + } + else { + $object = $class->_find_cache_get($cache_key, 'ids'); + unless ($object) { + $object = $class->SUPER::find(@args); + $class->_find_cache_set($cache_key, $object, 'ids'); + } + } + return $object; +} + +=head1 AUTHOR + +David Gustafsson + +=cut + +1; diff --git a/t/db_dependent/Koha/Libraries.t b/t/db_dependent/Koha/Libraries.t index 5c746d679d5..6a6f4a5bcd7 100755 --- a/t/db_dependent/Koha/Libraries.t +++ b/t/db_dependent/Koha/Libraries.t @@ -19,7 +19,7 @@ use Modern::Perl; -use Test::More tests => 13; +use Test::More tests => 14; use C4::Biblio; use C4::Context; @@ -32,6 +32,7 @@ use Koha::Library; use Koha::Libraries; use Koha::Database; use Koha::CirculationRules; +use Koha::Cache::Memory::Lite; use t::lib::Mocks; use t::lib::TestBuilder; @@ -413,3 +414,142 @@ subtest 'outgoing_transfers' => sub { $schema->storage->txn_rollback; }; + +subtest 'find cache tests' => sub { + plan tests => 15; + + $schema->storage->txn_begin; + + my $library1 = $builder->build_object( + { + class => 'Koha::Libraries', + value => { + branchname => 'My library' + } + } + ); + my $library2 = $builder->build_object( + { + class => 'Koha::Libraries', + value => { + branchname => 'My other library' + } + } + ); + + # Since build_object calls find internally + # we first have to flush the cache since these + # objects are now already cached + Koha::Cache::Memory::Lite->get_instance()->flush(); + + my $ids_bucket = Koha::Libraries->_find_cache_bucket('ids'); + ok(!%{$ids_bucket}, 'Find cache has been cleared after flushing memory cache'); + + my $cached_library = Koha::Libraries->find($library1->branchcode); + Koha::Libraries->find($library2->branchcode); + + my $cached_library_ids_bucket = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode), + 'ids' + ); + is (ref($cached_library_ids_bucket), 'Koha::Library', 'Library should be cached after previously have been fetched'); + is ($cached_library_ids_bucket->branchcode, $library1->branchcode, 'The cashed library should be the expected library'); + + # Set property of library by-passing the cache expiration logic + # so we can veriy library is not only present in cache by also + # properly retrieved in find + $cached_library->_result->set_column('branchname', 'My library test'); + $cached_library = Koha::Libraries->find($library1->branchcode); + is ($cached_library->branchname, 'My library test', 'The cashed library returned by find should be the cached library'); + + $library1->branchname('New branchname'); + $cached_library_ids_bucket = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode), + 'ids' + ); + is ($cached_library_ids_bucket, undef, 'Cache has been expired after changing library property'); + + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library2->branchcode), + 'ids' + ); + is (ref($cached_library), 'Koha::Library', 'Cache should still contain other cached libraries'); + + my $stored_library = Koha::Libraries->find($library1->branchcode); + is ($stored_library->branchname, 'My library', 'Library is fetched from database after cache has been expired'); + + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode), + 'ids' + ); + is (ref($cached_library), 'Koha::Library', 'Library should be cached after previously have been fetched'); + + $library1->store(); + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode), + 'ids' + ); + is ($cached_library, undef, 'Cache has been expired after saving library to database'); + + Koha::Libraries->find({ branchcode => $library1->branchcode }); + Koha::Libraries->find({ branchcode => $library2->branchcode }); + + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key({ branchcode => $library1->branchcode }), + 'args' + ); + is ( + ref($cached_library), + 'Koha::Library', + 'Library should be cached after previously have been fetched, and use the args cache bucket if find was called with column conditions' + ); + + $cached_library->_result->set_column('branchname', 'My library test'); + $cached_library = Koha::Libraries->find({ branchcode => $library1->branchcode }); + is ( + $cached_library->branchname, + 'My library test', + 'The cashed library returned by find should be the cached library, using the args cache bucket' + ); + + $cached_library->branchname('Some other branchname'); + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key({ branchcode => $library1->branchcode }), + 'args' + ); + is ( + $cached_library, + undef, + 'Cache has been expired after changing branchname, using the args cache bucket' + ); + + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key({ branchcode => $library2->branchcode }), + 'args' + ); + is ( + $cached_library, + undef, + 'The whole args cache bucket has been emptied after triggering cache expiration' + ); + + Koha::Libraries->find($library1->branchcode, { key => 'primary' }); + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode, { key => 'primary' }), + 'args' + ); + is ( + ref($cached_library), + 'Koha::Library', + 'The args cache bucket should be used if find is called with the attrs argument' + ); + + $library1->delete(); + $cached_library = Koha::Libraries->_find_cache_get( + Koha::Libraries->_find_cache_cache_key($library1->branchcode, { key => 'primary' }), + 'args' + ); + is ($cached_library, undef, 'Cache has been expired after deleting library'); + + $schema->storage->txn_rollback; +} -- 2.43.0