Bugzilla – Attachment 177379 Details for
Bug 36350
Add subclass of Koha::Objects that provides caching for find and search
Home
|
New
|
Browse
|
Search
|
[?]
|
Reports
|
Help
|
New Account
|
Log In
[x]
|
Forgot Password
Login:
[x]
[patch]
Bug 36350: Add caching for Objects::find and Objects::search
Bug-36350-Add-caching-for-Objectsfind-and-Objectss.patch (text/plain), 37.54 KB, created by
David Gustafsson
on 2025-01-31 10:55:47 UTC
(
hide
)
Description:
Bug 36350: Add caching for Objects::find and Objects::search
Filename:
MIME Type:
Creator:
David Gustafsson
Created:
2025-01-31 10:55:47 UTC
Size:
37.54 KB
patch
obsolete
>From 90f1b47562fb14ab01777f799da0428d012d894e Mon Sep 17 00:00:00 2001 >From: David Gustafsson <david.gustafsson@ub.gu.se> >Date: Fri, 15 Mar 2024 21:12:33 +0100 >Subject: [PATCH] Bug 36350: Add caching for Objects::find and Objects::search > >Add subclass of Koha::Objects that provides cached find and search. > >To test: >1) Ensure the following tests pass: > - t/db_dependent/Koha/Libraries.t > - t/db_dependent/Koha/ItemTypes.t > - t/db_dependent/Koha/Patrons.t > - t/db_dependent/Koha/Acquisition/Currencies.t > >Sponsored-by: Gothenburg University Library >--- > Koha/Acquisition/Currencies.pm | 4 +- > Koha/Acquisition/Currency.pm | 2 +- > Koha/ILL/Requests.pm | 2 +- > Koha/ItemType.pm | 2 +- > Koha/ItemTypes.pm | 2 +- > Koha/Libraries.pm | 2 +- > Koha/Library.pm | 2 +- > Koha/Object.pm | 3 + > Koha/Object/CachedExpiration.pm | 68 +++++++ > Koha/Objects.pm | 193 +++++++++++++++++++ > Koha/Objects/Cached.pm | 91 +++++++++ > Koha/Objects/Cached/Base.pm | 120 ++++++++++++ > Koha/Objects/Mixin/AdditionalFields.pm | 2 - > Koha/Objects/Mixin/ExtendedAttributes.pm | 234 ----------------------- > Koha/Patron.pm | 16 +- > Koha/Patrons.pm | 2 +- > acqui/acqui-home.pl | 10 +- > t/db_dependent/Koha/Libraries.t | 203 +++++++++++++++++++- > 18 files changed, 699 insertions(+), 259 deletions(-) > create mode 100644 Koha/Object/CachedExpiration.pm > create mode 100644 Koha/Objects/Cached.pm > create mode 100644 Koha/Objects/Cached/Base.pm > delete mode 100644 Koha/Objects/Mixin/ExtendedAttributes.pm > >diff --git a/Koha/Acquisition/Currencies.pm b/Koha/Acquisition/Currencies.pm >index 42f1d2ff200..09848688898 100644 >--- a/Koha/Acquisition/Currencies.pm >+++ b/Koha/Acquisition/Currencies.pm >@@ -22,7 +22,7 @@ use Koha::Database; > > use Koha::Acquisition::Currency; > >-use base qw(Koha::Objects); >+use base qw(Koha::Objects::Cached); > > =head1 NAME > >@@ -40,7 +40,7 @@ Koha::Acquisition::Currencies - Koha Acquisition Currency Object set class > > sub get_active { > my ( $self ) = @_; >- return $self->SUPER::search( { active => 1 } )->next; >+ return $self->search( { active => 1 } )->next; > } > > =head3 _type >diff --git a/Koha/Acquisition/Currency.pm b/Koha/Acquisition/Currency.pm >index bf1daaf1651..6e3841b31eb 100644 >--- a/Koha/Acquisition/Currency.pm >+++ b/Koha/Acquisition/Currency.pm >@@ -20,7 +20,7 @@ use Modern::Perl; > > use Koha::Database; > >-use base qw(Koha::Object); >+use base qw(Koha::Object::CachedExpiration); > > =head1 NAME > >diff --git a/Koha/ILL/Requests.pm b/Koha/ILL/Requests.pm >index 3f15d660f34..90ee97a39a4 100644 >--- a/Koha/ILL/Requests.pm >+++ b/Koha/ILL/Requests.pm >@@ -23,7 +23,7 @@ use Koha::Database; > use Koha::ILL::Request; > use Koha::ILL::Request::Config; > >-use base qw(Koha::Objects::Mixin::ExtendedAttributes Koha::Objects); >+use base qw(Koha::Objects); > > =head1 NAME > >diff --git a/Koha/ItemType.pm b/Koha/ItemType.pm >index f4c0c4aee98..7a65e251fde 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::CachedExpiration Koha::Object::Limit::Library); > > my $cache = Koha::Caches->get_instance(); > >diff --git a/Koha/ItemTypes.pm b/Koha/ItemTypes.pm >index 13caa648a81..9498a90bf91 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::Cached Koha::Objects::Limit::Library); > > =head1 NAME > >diff --git a/Koha/Libraries.pm b/Koha/Libraries.pm >index 20ceb8aa348..2ec9020c1da 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::Cached); > > =head1 NAME > >diff --git a/Koha/Library.pm b/Koha/Library.pm >index 8056c702920..73c1feda976 100644 >--- a/Koha/Library.pm >+++ b/Koha/Library.pm >@@ -29,7 +29,7 @@ use Koha::StockRotationStages; > use Koha::SMTP::Servers; > use Koha::Library::Hours; > >-use base qw(Koha::Object); >+use base qw(Koha::Object::CachedExpiration); > > my $cache = Koha::Caches->get_instance(); > >diff --git a/Koha/Object.pm b/Koha/Object.pm >index 8e254623bde..e0a0b15aeb1 100644 >--- a/Koha/Object.pm >+++ b/Koha/Object.pm >@@ -1017,6 +1017,9 @@ sub AUTOLOAD { > my $accessor = sub { > my $self = shift; > if (@_) { >+ if ($self->isa("Koha::Object::CachedExpiration")) { >+ $self->_objects_cache_expire(); >+ } > $self->_result()->set_column( $method, @_ ); > return $self; > } else { >diff --git a/Koha/Object/CachedExpiration.pm b/Koha/Object/CachedExpiration.pm >new file mode 100644 >index 00000000000..ca57ca4b5f6 >--- /dev/null >+++ b/Koha/Object/CachedExpiration.pm >@@ -0,0 +1,68 @@ >+package Koha::Object::CachedExpiration; >+ >+use parent qw( Koha::Object Koha::Objects::Cached::Base ); >+use Modern::Perl; >+use Data::Dumper; >+ >+=head1 NAME >+ >+Koha::Object::CachedExpiration >+ >+=head1 SYNOPSIS >+ >+ package Koha::Foo; >+ >+ use parent qw( Koha::Object::CachedExpiration ); >+ >+=head1 API >+ >+=head2 Class Methods >+ >+=cut >+ >+=head3 delete >+ >+Overloaded I<delete> method for cache expiration >+ >+=cut >+ >+sub delete { >+ my ($self) = @_; >+ $self->_objects_cache_expire(); >+ $self->SUPER::delete(); >+} >+ >+=head3 store >+ >+Overloaded I<store> method for cache expiration >+ >+=cut >+ >+sub store { >+ my ($self) = @_; >+ $self->_objects_cache_expire(); >+ $self->SUPER::store(); >+} >+ >+=head2 Internal methods >+ >+=head3 _objects_cache_expire >+ >+=cut >+ >+sub _objects_cache_expire { >+ my ($self) = @_; >+ if ($self->_result->in_storage) { >+ my @primary_keys = $self->_result->id; >+ my $ids_cache_key = $self->_objects_cache_cache_key('find', @primary_keys); >+ $self->_objects_cache_clear($ids_cache_key); >+ } >+} >+ >+=head1 AUTHOR >+ >+David Gustafsson <david.gustafsson@ub.gu.se> >+ >+=cut >+ >+1; >diff --git a/Koha/Objects.pm b/Koha/Objects.pm >index 3bd1e778863..e556719863d 100644 >--- a/Koha/Objects.pm >+++ b/Koha/Objects.pm >@@ -22,10 +22,12 @@ use Modern::Perl; > use Carp qw( carp ); > use List::MoreUtils qw( none ); > use Class::Inspector; >+use Scalar::Util qw( reftype ); > > use Koha::Database; > use Koha::Exceptions::Object; > >+ > =head1 NAME > > Koha::Objects - Koha Object set base class >@@ -136,11 +138,202 @@ sub search { > my ( $self, $params, $attributes ) = @_; > > my $class = ref($self) ? ref($self) : $self; >+ >+ $self->handle_query_extended_attributes( >+ { >+ attributes => $attributes, >+ filtered_params => $params, >+ } >+ ) if defined $attributes; >+ > my $rs = $self->_resultset()->search($params, $attributes); > > return $class->_new_from_dbic($rs); > } > >+=head3 handle_query_extended_attributes >+ >+ Checks for the presence of extended_attributes in a query >+ If present, it builds the dynamic extended attributes relations and rewrites the query to include the extended_attributes relation >+ >+=cut >+ >+sub handle_query_extended_attributes { >+ my ( $self, $args ) = @_; >+ >+ my $attributes = $args->{attributes}; >+ my $filtered_params = $args->{filtered_params}; >+ >+ if ( reftype( $attributes->{prefetch} ) >+ && reftype( $attributes->{prefetch} ) eq 'ARRAY' >+ && grep ( /extended_attributes/, @{ $attributes->{prefetch} } ) ) >+ { >+ >+ my @array = $self->_get_extended_attributes_entries($filtered_params); >+ >+ # Calling our private method to build the extended attributes relations >+ my @joins = $self->_build_extended_attributes_relations( \@array ); >+ push @{ $attributes->{join} }, @joins; >+ >+ } >+} >+ >+=head3 _get_extended_attributes_entries >+ >+ $self->_get_extended_attributes_entries( $filtered_params, 0 ) >+ >+Recursive function that returns the rewritten extended_attributes query entries. >+ >+Given: >+[ >+ '-and', >+ [ >+ { >+ 'extended_attributes.code' => 'CODE_1', >+ 'extended_attributes.attribute' => { 'like' => '%Bar%' } >+ }, >+ { >+ 'extended_attributes.attribute' => { 'like' => '%Bar%' }, >+ 'extended_attributes.code' => 'CODE_2' >+ } >+ ] >+]; >+ >+Returns : >+ >+[ >+ 'CODE_1', >+ 'CODE_2' >+] >+ >+=cut >+ >+sub _get_extended_attributes_entries { >+ my ( $self, $params, @array ) = @_; >+ >+ if ( reftype($params) && reftype($params) eq 'HASH' ) { >+ >+ # rewrite additional_field_values table query params >+ @array = _rewrite_related_metadata_query( $params, 'field_id', 'value', @array ) >+ if $params->{'extended_attributes.field_id'}; >+ >+ # rewrite borrower_attributes table query params >+ @array = _rewrite_related_metadata_query( $params, 'code', 'attribute', @array ) >+ if $params->{'extended_attributes.code'}; >+ >+ # rewrite illrequestattributes table query params >+ @array = _rewrite_related_metadata_query( $params, 'type', 'value', @array ) >+ if $params->{'extended_attributes.type'}; >+ >+ foreach my $key ( keys %{$params} ) { >+ return $self->_get_extended_attributes_entries( $params->{$key}, @array ); >+ } >+ } elsif ( reftype($params) && reftype($params) eq 'ARRAY' ) { >+ foreach my $ea_instance (@$params) { >+ @array = $self->_get_extended_attributes_entries( $ea_instance, @array ); >+ } >+ return @array; >+ } else { >+ return @array; >+ } >+} >+ >+=head3 _rewrite_related_metadata_query >+ >+ $extended_attributes_entries = >+ _rewrite_related_metadata_query( $params, 'field_id', 'value', @array ) >+ >+Helper function that rewrites all subsequent extended_attributes queries to match the alias generated by the dbic self left join >+Take the below example (patrons): >+ [ >+ { >+ "extended_attributes.attribute":{"like":"%123%"}, >+ "extended_attributes.code":"CODE_1" >+ } >+ ], >+ [ >+ { >+ "extended_attributes.attribute":{"like":"%abc%" }, >+ "extended_attributes.code":"CODE_2" >+ } >+ ] >+ >+It'll be rewritten as: >+ [ >+ { >+ 'extended_attributes_CODE_1.attribute' => { 'like' => '%123%' }, >+ 'extended_attributes_CODE_1.code' => 'CODE_1' >+ } >+ ], >+ [ >+ { >+ 'extended_attributes_CODE_2.attribute' => { 'like' => '%abc%' }, >+ 'extended_attributes_CODE_2.code' => 'CODE_2' >+ } >+ ] >+ >+=cut >+ >+sub _rewrite_related_metadata_query { >+ my ( $params, $key, $value, @array ) = @_; >+ >+ if ( ref \$params->{ 'extended_attributes.' . $key } eq 'SCALAR' ) { >+ my $old_key_value = delete $params->{ 'extended_attributes.' . $key }; >+ my $new_key_value = "extended_attributes_$old_key_value" . "." . $key; >+ $params->{$new_key_value} = $old_key_value; >+ >+ my $old_value_value = delete $params->{ 'extended_attributes.' . $value }; >+ my $new_value_value = "extended_attributes_$old_key_value" . "." . $value; >+ $params->{$new_value_value} = $old_value_value; >+ push @array, $old_key_value; >+ } >+ >+ return @array; >+} >+ >+=head3 _build_extended_attributes_relations >+ >+ Method to dynamically add has_many relations for Koha classes that support extended_attributes. >+ >+ Returns a list of relation accessor names. >+ >+=cut >+ >+sub _build_extended_attributes_relations { >+ my ( $self, $types ) = @_; >+ >+ return if ( !grep ( /extended_attributes/, keys %{ $self->_resultset->result_source->_relationships } ) ); >+ >+ my $ea_config = $self->extended_attributes_config; >+ >+ my $result_source = $self->_resultset->result_source; >+ for my $type ( @{$types} ) { >+ $result_source->add_relationship( >+ "extended_attributes_$type", >+ "$ea_config->{schema_class}", >+ sub { >+ my $args = shift; >+ >+ return { >+ "$args->{foreign_alias}.$ea_config->{id_field}->{foreign}" => >+ { -ident => "$args->{self_alias}.$ea_config->{id_field}->{self}" }, >+ "$args->{foreign_alias}.$ea_config->{key_field}" => { '=', $type }, >+ }; >+ }, >+ { >+ accessor => 'multi', >+ join_type => 'LEFT', >+ cascade_copy => 0, >+ cascade_delete => 0, >+ is_depends_on => 0 >+ }, >+ ); >+ >+ } >+ return map { 'extended_attributes_' . $_ } @{$types}; >+} >+ >+ > =head3 search_related > > my $objects = Koha::Objects->search_related( $rel_name, $cond?, \%attrs? ); >diff --git a/Koha/Objects/Cached.pm b/Koha/Objects/Cached.pm >new file mode 100644 >index 00000000000..d21530f7c31 >--- /dev/null >+++ b/Koha/Objects/Cached.pm >@@ -0,0 +1,91 @@ >+package Koha::Objects::Cached; >+ >+use parent qw( Koha::Objects Koha::Objects::Cached::Base ); >+use Modern::Perl; >+ >+=head1 NAME >+ >+Koha::Object::Cached >+ >+=head1 SYNOPSIS >+ >+ package Koha::Foo; >+ >+ use parent qw( Koha:Objects::Cached ); >+ >+=head1 API >+ >+=head2 Class Methods >+ >+=cut >+ >+=head3 find >+ >+Overloaded I<find> method that provides in memory caching by arguments. >+ >+=cut >+ >+sub find { >+ my ($class, @args) = @_; >+ my $cache_key = $class->_objects_cache_cache_key('find', @args); >+ # Store in the args bucket if has column value condiditions >+ # or for some reason the attributes argument is provided >+ my $has_options = @args > 1 && ref $args[$#args] eq 'HASH'; >+ my $cache = !($has_options && defined $args[$#args]->{cache} && !$args[$#args]->{cache}); >+ my $cache_bucket = ref $args[0] eq 'HASH' || $has_options ? 'args' : 'ids'; >+ my $object; >+ if ($cache) { >+ $object = $class->_objects_cache_get($cache_key, $cache_bucket); >+ } >+ if (!defined $object) { >+ $object = $class->SUPER::find(@args); >+ $object //= 'undef'; >+ $class->_objects_cache_set($cache_key, $object, $cache_bucket) if $cache; >+ } >+ elsif ($object ne 'undef' && defined $object->{'_cache'}) { >+ # Clear object cache if set >+ delete $object->{'_cache'}; >+ } >+ return $object eq 'undef' ? undef : $object; >+} >+ >+=head3 search >+ >+Overloaded I<search> method that provides in memory caching by arguments. >+ >+=cut >+ >+sub search { >+ my ($class, $cond, $attrs) = @_; >+ my $has_resultset = ref($class) && $class->{_resultset}; >+ $attrs //= {}; >+ $attrs->{cache} //= 1 unless $has_resultset; >+ >+ if ($has_resultset || !$attrs->{cache}) { >+ return $class->SUPER::search($cond, $attrs); >+ } >+ else { >+ my @args; >+ push(@args , $cond) if defined $cond; >+ # Don't include if only contains "cache" key >+ push(@args, $attrs) unless keys %{$attrs} == 1 && defined $attrs->{cache}; >+ my $cache_key = $class->_objects_cache_cache_key('search', @args); >+ my $objects = $class->_objects_cache_get($cache_key, 'args'); >+ if ($objects) { >+ $objects->reset; >+ } >+ else { >+ $objects = $class->SUPER::search($cond, $attrs); >+ $class->_objects_cache_set($cache_key, $objects, 'args'); >+ } >+ return $objects; >+ } >+} >+ >+=head1 AUTHOR >+ >+David Gustafsson <david.gustafsson@ub.gu.se> >+ >+=cut >+ >+1; >diff --git a/Koha/Objects/Cached/Base.pm b/Koha/Objects/Cached/Base.pm >new file mode 100644 >index 00000000000..ab5569e15c5 >--- /dev/null >+++ b/Koha/Objects/Cached/Base.pm >@@ -0,0 +1,120 @@ >+package Koha::Objects::Cached::Base; >+ >+use Modern::Perl; >+use Digest::MD5 qw( md5_hex ); >+use Carp qw( croak ); >+use JSON; >+use Data::Dumper; >+ >+use Koha::Cache::Memory::Lite; >+ >+=head1 NAME >+ >+Koha::Objects::Cached::Base >+ >+=head2 Internal methods >+ >+=head3 _objects_cache_cache_key >+ >+=cut >+ >+sub _objects_cache_cache_key { >+ my ($self, @args) = @_; >+ if (@args == 2 && !ref $args[1]) { >+ return join(':', @args); >+ } >+ # JSON is much faster than Data::Dumper but throws >+ # an exception for certain perl data strucures >+ # (non boolean scalar refs for example which can >+ # be used in DBIx conditions) >+ my $cache_key = eval { md5_hex(JSON->new->canonical(1)->encode(\@args)) }; >+ if ($cache_key) { >+ return $cache_key; >+ } else { >+ local $Data::Dumper::Sortkeys = 1; >+ return md5_hex(Dumper(\@args)); >+ } >+} >+ >+=head3 _objects_cache_bucket_key >+ >+=cut >+ >+sub _objects_cache_bucket_key { >+ my ($self, $bucket) = @_; >+ my %buckets = ( >+ 'ids' => 'ObjectsCachedIds', >+ 'args' => 'ObjectsCachedArgs' >+ ); >+ unless (exists $buckets{$bucket}) { >+ croak "Invalid cache bucket $bucket"; >+ } >+ return $self->_type . $buckets{$bucket}; >+ >+ >+} >+ >+=head3 _objects_cache_bucket >+ >+=cut >+ >+sub _objects_cache_bucket { >+ my ($self, $bucket) = @_; >+ my $memory_cache = Koha::Cache::Memory::Lite->get_instance(); >+ my $bucket_key = $self->_objects_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 _objects_cache_get >+ >+=cut >+ >+sub _objects_cache_get { >+ my ($self, $cache_key, $bucket) = @_; >+ my $cache = $self->_objects_cache_bucket($bucket); >+ return exists $cache->{$cache_key} ? $cache->{$cache_key} : undef; >+} >+ >+=head3 _objects_cache_set >+ >+=cut >+ >+sub _objects_cache_set { >+ my ($self, $cache_key, $object, $bucket) = @_; >+ my $cache = $self->_objects_cache_bucket($bucket); >+ $cache->{$cache_key} = $object; >+} >+ >+=head3 _objects_cache_clear >+ >+=cut >+ >+sub _objects_cache_clear { >+ my ($self, $ids_cache_key) = @_; >+ my $memory_cache = Koha::Cache::Memory::Lite->get_instance(); >+ if ($ids_cache_key) { >+ my $cache = $self->_objects_cache_bucket('ids'); >+ delete $cache->{$ids_cache_key}; >+ } >+ else { >+ $memory_cache->clear_from_cache( >+ $self->_objects_cache_bucket_key('ids') >+ ); >+ } >+ $memory_cache->clear_from_cache( >+ $self->_objects_cache_bucket_key('args') >+ ); >+} >+ >+=head1 AUTHOR >+ >+David Gustafsson <david.gustafsson@ub.gu.se> >+ >+=cut >+ >+1; >diff --git a/Koha/Objects/Mixin/AdditionalFields.pm b/Koha/Objects/Mixin/AdditionalFields.pm >index 1fe79af4a54..113f71a9cf4 100644 >--- a/Koha/Objects/Mixin/AdditionalFields.pm >+++ b/Koha/Objects/Mixin/AdditionalFields.pm >@@ -2,8 +2,6 @@ package Koha::Objects::Mixin::AdditionalFields; > > use Modern::Perl; > >-use base qw(Koha::Objects::Mixin::ExtendedAttributes); >- > =head1 NAME > > Koha::Objects::Mixin::AdditionalFields >diff --git a/Koha/Objects/Mixin/ExtendedAttributes.pm b/Koha/Objects/Mixin/ExtendedAttributes.pm >deleted file mode 100644 >index f18bb006d27..00000000000 >--- a/Koha/Objects/Mixin/ExtendedAttributes.pm >+++ /dev/null >@@ -1,234 +0,0 @@ >-package Koha::Objects::Mixin::ExtendedAttributes; >- >-# Copyright 2024 PTFS Europe Ltd >-# >-# This file is part of Koha. >-# >-# Koha is free software; you can redistribute it and/or modify it >-# under the terms of the GNU General Public License as published by >-# the Free Software Foundation; either version 3 of the License, or >-# (at your option) any later version. >-# >-# Koha is distributed in the hope that it will be useful, but >-# WITHOUT ANY WARRANTY; without even the implied warranty of >-# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the >-# GNU General Public License for more details. >-# >-# You should have received a copy of the GNU General Public License >-# along with Koha; if not, see <http://www.gnu.org/licenses>. >- >-use Modern::Perl; >-use Scalar::Util qw( reftype ); >- >-=head1 NAME >- >-Koha::Objects::Mixin::ExtendedAttributes >- >-=head2 Class methods >- >- >-=head3 search >- >- Overwrites the search method to include extended attributes rewrite and dynamic relation accessors >- >-=cut >- >-sub search { >- my ( $self, $params, $attributes ) = @_; >- >- my $class = ref($self) ? ref($self) : $self; >- >- $self->handle_query_extended_attributes( >- { >- attributes => $attributes, >- filtered_params => $params, >- } >- ); >- >- my $rs = $self->_resultset()->search( $params, $attributes ); >- return $class->_new_from_dbic($rs); >-} >- >-=head3 handle_query_extended_attributes >- >- Checks for the presence of extended_attributes in a query >- If present, it builds the dynamic extended attributes relations and rewrites the query to include the extended_attributes relation >- >-=cut >- >-sub handle_query_extended_attributes { >- my ( $self, $args ) = @_; >- >- my $attributes = $args->{attributes}; >- my $filtered_params = $args->{filtered_params}; >- >- if ( reftype( $attributes->{prefetch} ) >- && reftype( $attributes->{prefetch} ) eq 'ARRAY' >- && grep ( /extended_attributes/, @{ $attributes->{prefetch} } ) ) >- { >- >- my @array = $self->_get_extended_attributes_entries($filtered_params); >- >- # Calling our private method to build the extended attributes relations >- my @joins = $self->_build_extended_attributes_relations( \@array ); >- push @{ $attributes->{join} }, @joins; >- >- } >-} >- >-=head3 _get_extended_attributes_entries >- >- $self->_get_extended_attributes_entries( $filtered_params, 0 ) >- >-Recursive function that returns the rewritten extended_attributes query entries. >- >-Given: >-[ >- '-and', >- [ >- { >- 'extended_attributes.code' => 'CODE_1', >- 'extended_attributes.attribute' => { 'like' => '%Bar%' } >- }, >- { >- 'extended_attributes.attribute' => { 'like' => '%Bar%' }, >- 'extended_attributes.code' => 'CODE_2' >- } >- ] >-]; >- >-Returns : >- >-[ >- 'CODE_1', >- 'CODE_2' >-] >- >-=cut >- >-sub _get_extended_attributes_entries { >- my ( $self, $params, @array ) = @_; >- >- if ( reftype($params) && reftype($params) eq 'HASH' ) { >- >- # rewrite additional_field_values table query params >- @array = _rewrite_related_metadata_query( $params, 'field_id', 'value', @array ) >- if $params->{'extended_attributes.field_id'}; >- >- # rewrite borrower_attributes table query params >- @array = _rewrite_related_metadata_query( $params, 'code', 'attribute', @array ) >- if $params->{'extended_attributes.code'}; >- >- # rewrite illrequestattributes table query params >- @array = _rewrite_related_metadata_query( $params, 'type', 'value', @array ) >- if $params->{'extended_attributes.type'}; >- >- foreach my $key ( keys %{$params} ) { >- return $self->_get_extended_attributes_entries( $params->{$key}, @array ); >- } >- } elsif ( reftype($params) && reftype($params) eq 'ARRAY' ) { >- foreach my $ea_instance (@$params) { >- @array = $self->_get_extended_attributes_entries( $ea_instance, @array ); >- } >- return @array; >- } else { >- return @array; >- } >-} >- >-=head3 _rewrite_related_metadata_query >- >- $extended_attributes_entries = >- _rewrite_related_metadata_query( $params, 'field_id', 'value', @array ) >- >-Helper function that rewrites all subsequent extended_attributes queries to match the alias generated by the dbic self left join >-Take the below example (patrons): >- [ >- { >- "extended_attributes.attribute":{"like":"%123%"}, >- "extended_attributes.code":"CODE_1" >- } >- ], >- [ >- { >- "extended_attributes.attribute":{"like":"%abc%" }, >- "extended_attributes.code":"CODE_2" >- } >- ] >- >-It'll be rewritten as: >- [ >- { >- 'extended_attributes_CODE_1.attribute' => { 'like' => '%123%' }, >- 'extended_attributes_CODE_1.code' => 'CODE_1' >- } >- ], >- [ >- { >- 'extended_attributes_CODE_2.attribute' => { 'like' => '%abc%' }, >- 'extended_attributes_CODE_2.code' => 'CODE_2' >- } >- ] >- >-=cut >- >-sub _rewrite_related_metadata_query { >- my ( $params, $key, $value, @array ) = @_; >- >- if ( ref \$params->{ 'extended_attributes.' . $key } eq 'SCALAR' ) { >- my $old_key_value = delete $params->{ 'extended_attributes.' . $key }; >- my $new_key_value = "extended_attributes_$old_key_value" . "." . $key; >- $params->{$new_key_value} = $old_key_value; >- >- my $old_value_value = delete $params->{ 'extended_attributes.' . $value }; >- my $new_value_value = "extended_attributes_$old_key_value" . "." . $value; >- $params->{$new_value_value} = $old_value_value; >- push @array, $old_key_value; >- } >- >- return @array; >-} >- >-=head3 _build_extended_attributes_relations >- >- Method to dynamically add has_many relations for Koha classes that support extended_attributes. >- >- Returns a list of relation accessor names. >- >-=cut >- >-sub _build_extended_attributes_relations { >- my ( $self, $types ) = @_; >- >- return if ( !grep ( /extended_attributes/, keys %{ $self->_resultset->result_source->_relationships } ) ); >- >- my $ea_config = $self->extended_attributes_config; >- >- my $result_source = $self->_resultset->result_source; >- for my $type ( @{$types} ) { >- $result_source->add_relationship( >- "extended_attributes_$type", >- "$ea_config->{schema_class}", >- sub { >- my $args = shift; >- >- return { >- "$args->{foreign_alias}.$ea_config->{id_field}->{foreign}" => >- { -ident => "$args->{self_alias}.$ea_config->{id_field}->{self}" }, >- "$args->{foreign_alias}.$ea_config->{key_field}" => { '=', $type }, >- }; >- }, >- { >- accessor => 'multi', >- join_type => 'LEFT', >- cascade_copy => 0, >- cascade_delete => 0, >- is_depends_on => 0 >- }, >- ); >- >- } >- return map { 'extended_attributes_' . $_ } @{$types}; >-} >- >-1; >diff --git a/Koha/Patron.pm b/Koha/Patron.pm >index 20ac75196d8..88a22ac255f 100644 >--- a/Koha/Patron.pm >+++ b/Koha/Patron.pm >@@ -67,7 +67,7 @@ use Koha::Subscription::Routinglists; > use Koha::Token; > use Koha::Virtualshelves; > >-use base qw(Koha::Object); >+use base qw(Koha::Object::CachedExpiration); > > use constant ADMINISTRATIVE_LOCKOUT => -1; > >@@ -729,7 +729,9 @@ sub merge_with { > > next if $patron_id eq $anonymous_patron; > >- my $patron = Koha::Patrons->find( $patron_id ); >+ # Don't use cache as this could risk deleting a patron object >+ # which has a reference outside of this class >+ my $patron = Koha::Patrons->find( $patron_id, { cache => 0 } ); > > next unless $patron; > >@@ -2018,8 +2020,10 @@ sub libraries_where_can_see_things { > my $subpermission = $params->{subpermission}; > my $group_feature = $params->{group_feature}; > >- return @{ $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} } >- if exists( $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} ); >+ $self->{'_cache'} //= {}; >+ >+ return @{ $self->{'_cache'}->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} } >+ if exists( $self->{'_cache'}->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} ); > > my $userenv = C4::Context->userenv; > >@@ -2059,8 +2063,8 @@ sub libraries_where_can_see_things { > @restricted_branchcodes = uniq(@restricted_branchcodes); > @restricted_branchcodes = sort(@restricted_branchcodes); > >- $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} = \@restricted_branchcodes; >- return @{ $self->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} }; >+ $self->{'_cache'}->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} = \@restricted_branchcodes; >+ return @{ $self->{'_cache'}->{"_restricted_branchcodes:$permission:$subpermission:$group_feature"} }; > } > > =head3 has_permission >diff --git a/Koha/Patrons.pm b/Koha/Patrons.pm >index 04d3bf05f6d..21507eb4812 100644 >--- a/Koha/Patrons.pm >+++ b/Koha/Patrons.pm >@@ -30,7 +30,7 @@ use Koha::Exceptions::Patron; > use Koha::Exceptions::SysPref; > use Koha::Patron::Categories; > >-use base qw(Koha::Objects::Mixin::ExtendedAttributes Koha::Objects); >+use base qw(Koha::Objects::Cached); > > =head1 NAME > >diff --git a/acqui/acqui-home.pl b/acqui/acqui-home.pl >index af1034d3093..843697c203a 100755 >--- a/acqui/acqui-home.pl >+++ b/acqui/acqui-home.pl >@@ -83,16 +83,12 @@ my $totordered_active = 0; > my $totavail_active = 0; > > my @budget_loop; >-my %patrons = ( $loggedinuser => Koha::Patrons->find($loggedinuser) ); >-my $loggedinpatron = $patrons{$loggedinuser}->unblessed; >+my $loggedinpatron = Koha::Patrons->find($loggedinuser); > foreach my $budget ( @{$budget_arr} ) { > next unless ( CanUserUseBudget( $loggedinpatron, $budget, $userflags ) ); > >- if ( my $borrowernumber = $budget->{budget_owner_id} ) { >- unless ( exists $patrons{$borrowernumber} ) { >- $patrons{$borrowernumber} = Koha::Patrons->find($borrowernumber); >- } >- $budget->{budget_owner} = $patrons{$borrowernumber}; >+ if ( $budget->{budget_owner_id} ) { >+ $budget->{budget_owner} = Koha::Patrons->find($budget->{budget_owner_id}); > } > > if ( !defined $budget->{budget_amount} ) { >diff --git a/t/db_dependent/Koha/Libraries.t b/t/db_dependent/Koha/Libraries.t >index 5c746d679d5..947eb20d3a8 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,203 @@ subtest 'outgoing_transfers' => sub { > > $schema->storage->txn_rollback; > }; >+ >+subtest 'cache tests' => sub { >+ plan tests => 24; >+ >+ $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->_objects_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->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $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 in cache'); >+ $cached_library = Koha::Libraries->find($library1->branchcode); >+ is ( >+ $cached_library->branchname, >+ 'My library in cache', >+ 'The cashed library returned by find should be the cached library' >+ ); >+ >+ $library1->branchname('My expired library'); >+ $cached_library_ids_bucket = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode), >+ 'ids' >+ ); >+ is ( >+ $cached_library_ids_bucket, >+ undef, >+ 'Cache has been expired after changing library property' >+ ); >+ >+ $cached_library = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $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->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode), >+ 'ids' >+ ); >+ is ( >+ ref($cached_library), >+ 'Koha::Library', >+ 'Library should be cached after previously have been fetched' >+ ); >+ >+ $library1->store(); >+ $cached_library = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $library1->branchcode), >+ 'ids' >+ ); >+ is ($cached_library, undef, 'Cache has been expired after saving library to database'); >+ >+ Koha::Libraries->find($library1->branchcode, { key => 'primary' }); >+ $cached_library = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $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' >+ ); >+ my $cached_value; >+ >+ for my $method ('find', 'search') { >+ >+ Koha::Libraries->$method({ branchcode => $library1->branchcode }); >+ Koha::Libraries->$method({ branchcode => $library2->branchcode }); >+ >+ $cached_value = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }), >+ 'args' >+ ); >+ $cached_library = $method eq 'search' ? $cached_value->next : $cached_value; >+ is ( >+ ref($cached_library), >+ 'Koha::Library', >+ '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') >+ ); >+ >+ $cached_library->_result->set_column('branchname', 'My library in cache'); >+ $cached_value = Koha::Libraries->$method({ branchcode => $library1->branchcode }); >+ $cached_library = $method eq 'search' ? $cached_value->next : $cached_value; >+ is ( >+ $cached_library->branchname, >+ 'My library in cache', >+ "The cashed library returned by $method should be the cached library, using the args cache bucket" >+ ); >+ >+ $cached_library->branchname('My expired library'); >+ $cached_value = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library1->branchcode }), >+ 'args' >+ ); >+ is ( >+ $cached_value, >+ undef, >+ 'Cache has been expired after changing branchname, using the args cache bucket' >+ ); >+ >+ $cached_value = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key($method, { branchcode => $library2->branchcode }), >+ 'args' >+ ); >+ is ( >+ $cached_value, >+ undef, >+ 'The whole args cache bucket has been emptied after triggering cache expiration' >+ ); >+ } >+ >+ Koha::Libraries->find($library2->branchcode); >+ >+ my $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode }); >+ $libraries->next; >+ is($libraries->next, undef, 'Cached libraries search result iterator has been exhausted'); >+ >+ $libraries = Koha::Libraries->search({ branchcode => $library1->branchcode }); >+ is(ref($libraries->next), 'Koha::Library', 'Cached libraries search result iterator has been reset'); >+ >+ >+ my $cached_libraries = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }), >+ 'args' >+ ); >+ is ( >+ ref($cached_libraries), >+ 'Koha::Libraries', >+ 'Libraries should be cached after previously have been fetched' >+ ); >+ >+ $library1->delete(); >+ $cached_libraries = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('search', { 'branchcode' => $library1->branchcode }), >+ 'args' >+ ); >+ is ($cached_libraries, undef, 'Search cache has been expired after deleting library'); >+ >+ $cached_library = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode), >+ 'ids' >+ ); >+ is ( >+ ref($cached_library), >+ 'Koha::Library', >+ 'Library should be cached after previously have been fetched' >+ ); >+ $library2->delete(); >+ $cached_library = Koha::Libraries->_objects_cache_get( >+ Koha::Libraries->_objects_cache_cache_key('find', $library2->branchcode), >+ 'ids' >+ ); >+ is ($cached_library, undef, 'Find cache has been expired after deleting library'); >+ >+ $schema->storage->txn_rollback; >+} >-- >2.48.1
You cannot view the attachment while viewing its details because your browser does not support IFRAMEs.
View the attachment on a separate page
.
View Attachment As Diff
View Attachment As Raw
Actions:
View
|
Diff
|
Splinter Review
Attachments on
bug 36350
:
163357
|
163361
|
163857
|
163858
|
163872
|
163873
|
163874
|
163945
|
177311
|
177370
|
177371
| 177379