From ed05be83657643c30053c26b47bcde512c95dc74 Mon Sep 17 00:00:00 2001
From: David Gustafsson <david.gustafsson@ub.gu.se>
Date: Thu, 29 Sep 2022 17:18:01 +0200
Subject: [PATCH] Bug 32476: Add caching for relatively expensive patron
 methods

To test:
1) Ensure tests in t/db_dependant/Koha/Patrons.t all pass

Sponsored-by: Gothenburg University Library
---
 C4/Circulation.pm             |  6 +--
 Koha/Object.pm                | 87 +++++++++++++++++++++++++++++++++++
 Koha/Patron.pm                | 51 +++++++++++++++++---
 t/db_dependent/Koha/Patrons.t | 61 +++++++++++++++++++++---
 4 files changed, 190 insertions(+), 15 deletions(-)

diff --git a/C4/Circulation.pm b/C4/Circulation.pm
index 2ebe5cbe6e3..9761cc8042a 100644
--- a/C4/Circulation.pm
+++ b/C4/Circulation.pm
@@ -3009,7 +3009,7 @@ sub CanBookBeRenewed {
         my $overduesblockrenewing = C4::Context->preference('OverduesBlockRenewing');
         my $restrictionblockrenewing = C4::Context->preference('RestrictionBlockRenewing');
         my $restricted  = $patron->is_debarred;
-        my $hasoverdues = $patron->has_overdues;
+        my $hasoverdues = $patron->has_overdues({ cache => 1 });
 
         if ( $restricted and $restrictionblockrenewing ) {
             return ( 0, 'restriction');
@@ -3311,7 +3311,7 @@ sub AddRenewal {
         my $overdue_restrictions = $patron->restrictions->search({ type => 'OVERDUES' });
         if ( $patron
           && $patron->is_debarred
-          && ! $patron->has_overdues
+          && !$patron->has_overdues
           && $overdue_restrictions->count
         ) {
             DelUniqueDebarment({ borrowernumber => $borrowernumber, type => 'OVERDUES' });
@@ -4536,7 +4536,7 @@ sub _CanBookBeAutoRenewed {
         }
     );
 
-    if ( $patron->is_expired && $patron->category->effective_BlockExpiredPatronOpacActions ) {
+    if ( $patron->is_expired({ cache => 1 }) && $patron->category->effective_BlockExpiredPatronOpacActions ) {
         return 'auto_account_expired';
     }
 
diff --git a/Koha/Object.pm b/Koha/Object.pm
index 97ae3494fd2..7b7fc5757e3 100644
--- a/Koha/Object.pm
+++ b/Koha/Object.pm
@@ -88,6 +88,93 @@ sub new {
 
 }
 
+=head3 Koha::Object->_instance_cache_key();
+
+my $instance_cache_key = Koha::Object->_instance_cache_key($key);
+
+=cut
+
+sub _instance_cache_key {
+    my ($self, $key) = @_;
+    warn "_instance_cache_key must not be called on object that has not been stored" unless $self->id;
+    return $self->_type . ':' . $self->id  . ':' . $key;
+}
+
+=head3 Koha::Object->_instance_cache_get();
+
+my $value = Koha::Object->_instance_cache_get($cache_key);
+
+=cut
+
+sub _instance_cache_get {
+    my ($self, $key) = @_;
+    return unless $self->id;
+    return Koha::Cache::Memory::Lite->get_instance->get_from_cache(
+        $self->_instance_cache_key($key)
+    );
+}
+
+=head3 Koha::Object->_instance_cache_set();
+
+Koha::Object->_instance_cache_set($cache_key, $value);
+
+=cut
+
+sub _instance_cache_set {
+    my ($self, $key, $value) = @_;
+    return unless $self->id;
+    $self->{_cache}->{$key} = $value;
+    return Koha::Cache::Memory::Lite->get_instance->set_in_cache(
+        $self->_instance_cache_key($key),
+        $value
+    );
+}
+
+=head3 Koha::Object->_instance_cache_clear($cache_key);
+
+Koha::Object->_instance_cache_clear($cache_key);
+Koha::Object->_instance_cache_clear();
+
+=cut
+
+sub _instance_cache_clear {
+    my ($self, $key) = @_;
+    return unless $self->id;
+    Koha::Cache::Memory::Lite->get_instance->clear_from_cache(
+        $self->_instance_cache_key($key)
+    )
+}
+
+=head3 Koha::Object->_accessor_cache($method_name);
+
+my $value = Koha::Object->_accessor_cache($method_name);
+
+=cut
+
+sub _accessor_cache {
+    my ($self, $method_name) = @_;
+
+    my $value = $self->_instance_cache_get($method_name);
+
+    return $value if defined $value;
+
+    $value = $self->$method_name();
+    $self->_instance_cache_set($method_name, $value);
+
+    return $value;
+}
+
+=head3 Koha::Object->accessor_cache_clear($method_name);
+
+Koha::Object->accessor_cache_clear($method_name);
+
+=cut
+
+sub accessor_cache_clear {
+    my ($self, $method_name) = @_;
+    $self->_instance_cache_clear($method_name);
+}
+
 =head3 Koha::Object->_new_from_dbic();
 
 my $object = Koha::Object->_new_from_dbic($dbic_row);
diff --git a/Koha/Patron.pm b/Koha/Patron.pm
index 73212772340..65e346c9bb1 100644
--- a/Koha/Patron.pm
+++ b/Koha/Patron.pm
@@ -793,20 +793,53 @@ sub is_debarred {
     return;
 }
 
+=head3 dateexpiry
+
+Override Patron::dateexpiry to invalidate Patron::is_expired cache.
+
+=cut
+
+sub dateexpiry {
+    my $self = shift @_;
+    if (@_) {
+        $self->_instance_cache_clear('is_expired');
+    }
+    return $self->SUPER::dateexpiry(@_);
+}
+
+=head3 set
+
+Override Patron::set to invalidate Patron::is_expired cache if dateexpiry is set.
+
+=cut
+
+sub set {
+    my $self = shift @_;
+    my ($properties) = @_;
+    if (exists $properties->{dateexpiry}) {
+        $self->_instance_cache_clear('is_expired');
+    }
+    return $self->SUPER::set(@_);
+}
+
 =head3 is_expired
 
 my $is_expired = $patron->is_expired;
+my $is_expired = $patron->is_expired({ cache => 1});
 
 Returns 1 if the patron is expired or 0;
 
 =cut
 
 sub is_expired {
-    my ($self) = @_;
-    return 0 unless $self->dateexpiry;
-    return 0 if $self->dateexpiry =~ '^9999';
-    return 1 if dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' );
-    return 0;
+    my ($self, $params) = @_;
+    $params //= {};
+    return $self->_accessor_cache('is_expired') if $params->{cache};
+
+    $self->_instance_cache_clear('is_expired');
+    return $self->dateexpiry &&
+        $self->dateexpiry !~ '^9999' &&
+        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
 }
 
 =head3 is_active
@@ -1071,13 +1104,19 @@ sub renew_account {
 =head3 has_overdues
 
 my $has_overdues = $patron->has_overdues;
+my $has_overdues = $patron->has_overdues({ cache => 1 });
 
 Returns the number of patron's overdues
 
 =cut
 
 sub has_overdues {
-    my ($self) = @_;
+    my ($self, $params) = @_;
+    $params //= {};
+
+    return $self->_accessor_cache('has_overdues') if $params->{cache};
+
+    $self->_instance_cache_clear('has_overdues');
     my $date = dt_from_string();
     my $dtf = Koha::Database->new->schema->storage->datetime_parser;
     return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
diff --git a/t/db_dependent/Koha/Patrons.t b/t/db_dependent/Koha/Patrons.t
index 24d4f7a811f..16c22c77f65 100755
--- a/t/db_dependent/Koha/Patrons.t
+++ b/t/db_dependent/Koha/Patrons.t
@@ -264,7 +264,7 @@ subtest 'siblings' => sub {
 };
 
 subtest 'has_overdues' => sub {
-    plan tests => 3;
+    plan tests => 12;
 
     my $item_1 = $builder->build_sample_item;
     my $retrieved_patron = Koha::Patrons->find( $new_patron_1->borrowernumber );
@@ -273,26 +273,75 @@ subtest 'has_overdues' => sub {
     my $tomorrow = DateTime->today( time_zone => C4::Context->tz() )->add( days => 1 );
     my $issue = Koha::Checkout->new({ borrowernumber => $new_patron_1->id, itemnumber => $item_1->itemnumber, date_due => $tomorrow, branchcode => $library->{branchcode} })->store();
     is( $retrieved_patron->has_overdues, 0, );
+
+    # Cache is set
+    is( $retrieved_patron->has_overdues({ cache => 1}), 0, );
+    is( $retrieved_patron->_instance_cache_get('has_overdues'), 0, 'has_overdues cache has been set');
+    # Cache is used
+    is( $retrieved_patron->has_overdues({ cache => 1}), 0, 'has_overdues cache is used');
+
     $issue->delete();
     my $yesterday = DateTime->today(time_zone => C4::Context->tz())->add( days => -1 );
     $issue = Koha::Checkout->new({ borrowernumber => $new_patron_1->id, itemnumber => $item_1->itemnumber, date_due => $yesterday, branchcode => $library->{branchcode} })->store();
     $retrieved_patron = Koha::Patrons->find( $new_patron_1->borrowernumber );
     is( $retrieved_patron->has_overdues, 1, );
+    is( $retrieved_patron->_instance_cache_get('has_overdues'), undef, 'has_overdues cache has been invalidated' );
+    # Cache is set
+    is( $retrieved_patron->has_overdues({ cache => 1}), 1, );
+    is ( $retrieved_patron->_instance_cache_get('has_overdues'), 1, 'has_overdues cache has been set' );
+    # Cache is used
+    is( $retrieved_patron->has_overdues({ cache => 1}), 1, 'has_overdues cache is used');
+
     $issue->delete();
+
+    # Cache is used (with stale entry, flushing cache must be handled manually as automatic invalidation is
+    # complex and probably not worth the effort)
+    is( $retrieved_patron->has_overdues({ cache => 1}), 1, );
+
+    # Cache has been invalidated
+    is( $retrieved_patron->has_overdues, 0, );
 };
 
 subtest 'is_expired' => sub {
-    plan tests => 4;
+    plan tests => 15;
     my $patron = $builder->build({ source => 'Borrower' });
     $patron = Koha::Patrons->find( $patron->{borrowernumber} );
     $patron->dateexpiry( undef )->store->discard_changes;
-    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set');
+    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is not set' );
     $patron->dateexpiry( dt_from_string )->store->discard_changes;
-    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today');
+    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is today' );
     $patron->dateexpiry( dt_from_string->add( days => 1 ) )->store->discard_changes;
-    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow');
+    is( $patron->is_expired, 0, 'Patron should not be considered expired if dateexpiry is tomorrow' );
+    $patron->dateexpiry( dt_from_string->add( days => -1 ) )->store->discard_changes;
+    is( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday' );
+
+    # Test is_expired cache
+    $patron->dateexpiry( undef )->store->discard_changes;
+    # Set cache
+    is( $patron->is_expired({ cache => 1 }), 0, 'Patron should not be considered expired if dateexpiry is not set, with caching enabled' );
+    is( $patron->_instance_cache_get('is_expired'), 0, 'is_expired cache has been set');
+    is( $patron->is_expired({ cache => 1 }), 0, 'Patron should not be considered expired if dateexpiry is not set, with caching enabled and cache hit' );
     $patron->dateexpiry( dt_from_string->add( days => -1 ) )->store->discard_changes;
-    is( $patron->is_expired, 1, 'Patron should be considered expired if dateexpiry is yesterday');
+    is( $patron->is_expired({ cache => 1 }), 1, 'Patron should be considered expired if dateexpiry is yesterday, cache has been invalidated' );
+    is( $patron->_instance_cache_get('is_expired'), 1, 'is_expired cache has been set');
+    is( $patron->is_expired({ cache => 1 }), 1, 'Patron should be considered expired if dateexpiry is yesterday, on cache hit' );
+
+    $patron->{dateexpiry} = undef;
+    # Checking cache is really utilized by setting dateexpiry property without using accessor method
+    is( $patron->is_expired({ cache => 1 }), 1, 'Cache is used with stale value' );
+
+    $patron->set({ dateexpiry => undef })->store->discard_changes;
+    is( $patron->is_expired({ cache => 1 }), 0, 'Patron should not be considered expired if dateexpiry is not set, cache has been invalidated' );
+    is( $patron->is_expired({ cache => 1 }), 0, 'Patron should not be considered expired if dateexpiry is not set, on cache hit' );
+
+    $patron->is_expired;
+    is( $patron->_instance_cache_get('is_expired'), undef , 'Cache has been invalidated after calling is_expired without caching enabled' );
+
+    # Set cache
+    $patron->is_expired({ cache => 1 });
+    # Clear cache using public method accessor_cache_clear
+    $patron->accessor_cache_clear('is_expired');
+    is( $patron->_instance_cache_get('is_expired'), undef , 'Cache has been invalidated after calling accessor_cache_clear' );
 
     $patron->delete;
 };
-- 
2.42.0