Attachment #162537 for bug #32476

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

Lines 25-30 use Mojo::JSON; Link Here

(-)a/Koha/Object.pm (-15 / +44 lines)
25	use Scalar::Util qw( blessed looks_like_number );	25	use Scalar::Util qw( blessed looks_like_number );
26	use Try::Tiny qw( catch try );	26	use Try::Tiny qw( catch try );
27	use List::MoreUtils qw( any );	27	use List::MoreUtils qw( any );
		28	use Data::Dumper;
		29	use Digest::MD5 qw( md5_hex );
28		30
29	use Koha::Database;	31	use Koha::Database;
30	use Koha::Exceptions::Object;	32	use Koha::Exceptions::Object;
Lines 96-105 my $instance_cache_key = Koha::Object->_instance_cache_key($key); Link Here
96		98
97	sub _instance_cache_key {	99	sub _instance_cache_key {
98	my ($self, $key) = @_;	100	my ($self, $key) = @_;
99	warn "_instance_cache_key must not be called on object that has not been stored" unless $self->id;	101	croak "_instance_cache_key must not be called on object that has not been stored" unless $self->id;
100	return $self->_type . ':' . $self->id . ':' . $key;	102	return $self->_type . ':' . $self->id . ':' . $key;
101	}	103	}
102		104
		105	=head3 Koha::Object->_method_cache_key();
		106
		107	my $method_cache_key = Koha::Object->_method_cache_key($key, @args);
		108
		109	=cut
		110
		111	sub _method_cache_key {
		112	my ($self, $method, @args) = @_;
		113	if (@args) {
		114	if(ref $args[0] eq 'HASH') {
		115	if (!%{$args[0]} && @args == 1) {
		116	return $method;
		117	}
		118	}
		119	else {
		120	croak "First argument to _instance_cache_key must be hashref";
		121	}
		122	local $Data::Dumper::Sortkeys = 1;
		123	return $method . md5_hex(Dumper(\@args));
		124	}
		125	return $method;
		126	}
		127
103	=head3 Koha::Object->_instance_cache_get();	128	=head3 Koha::Object->_instance_cache_get();
104		129
105	my $value = Koha::Object->_instance_cache_get($cache_key);	130	my $value = Koha::Object->_instance_cache_get($cache_key);
Lines 123-129 Koha::Object->_instance_cache_set($cache_key, $value); Link Here
123	sub _instance_cache_set {	148	sub _instance_cache_set {
124	my ($self, $key, $value) = @_;	149	my ($self, $key, $value) = @_;
125	return unless $self->id;	150	return unless $self->id;
126	$self->{_cache}->{$key} = $value;
127	return Koha::Cache::Memory::Lite->get_instance->set_in_cache(	151	return Koha::Cache::Memory::Lite->get_instance->set_in_cache(
128	$self->_instance_cache_key($key),	152	$self->_instance_cache_key($key),
129	$value	153	$value
Lines 133-139 sub _instance_cache_set { Link Here
133	=head3 Koha::Object->_instance_cache_clear($cache_key);	157	=head3 Koha::Object->_instance_cache_clear($cache_key);
134		158
135	Koha::Object->_instance_cache_clear($cache_key);	159	Koha::Object->_instance_cache_clear($cache_key);
136	Koha::Object->_instance_cache_clear();
137		160
138	=cut	161	=cut
139		162
Lines 145-178 sub _instance_cache_clear { Link Here
145	)	168	)
146	}	169	}
147		170
148	=head3 Koha::Object->_accessor_cache($method_name);	171	=head3 Koha::Object->_method_cache($method_name);
149		172
150	my $value = Koha::Object->_accessor_cache($method_name);	173	my $value = Koha::Object->_method_cache($method_name, @args);
151		174
152	=cut	175	=cut
153		176
154	sub _accessor_cache {	177	sub _method_cache {
155	my ($self, $method_name) = @_;	178	my ($self, $method_name, @args) = @_;
156		179
157	my $value = $self->_instance_cache_get($method_name);	180	my $cache_key = $self->_method_cache_key($method_name, @args);
		181	my $value = $self->_instance_cache_get($cache_key);
158		182
159	return $value if defined $value;	183	return $value if defined $value;
160		184
161	$value = $self->$method_name();	185	if (@args) {
162	$self->_instance_cache_set($method_name, $value);	186	delete $args[0]->{cache};
		187	}
		188	$value = $self->$method_name(@args);
		189
		190	$self->_instance_cache_set($cache_key, $value);
163		191
164	return $value;	192	return $value;
165	}	193	}
166		194
167	=head3 Koha::Object->accessor_cache_clear($method_name);	195	=head3 Koha::Object->_method_cache_clear($method_name, @args);
168		196
169	Koha::Object->accessor_cache_clear($method_name);	197	Koha::Object->_method_cache_clear($method_name, @args);
170		198
171	=cut	199	=cut
172		200
173	sub accessor_cache_clear {	201	sub _method_cache_clear {
174	my ($self, $method_name) = @_;	202	my ($self, $method_name, @args) = @_;
175	$self->_instance_cache_clear($method_name);	203	my $cache_key = $self->_method_cache_key($method_name, @args);
		204	$self->_instance_cache_clear($cache_key);
176	}	205	}
177		206
178	=head3 Koha::Object->_new_from_dbic();	207	=head3 Koha::Object->_new_from_dbic();




sub dateexpiry {
    my $self = shift @_;
    if (@_) {
        $self->_method_cache_clear('is_expired');
    }
    return $self->SUPER::dateexpiry(@_);
}

    my $self = shift @_;
    my ($properties) = @_;
    if (exists $properties->{dateexpiry}) {
        $self->_method_cache_clear('is_expired');
    }
    return $self->SUPER::set(@_);
}

sub is_expired {
    my ($self, $params) = @_;
    $params //= {};
    return $self->_method_cache('is_expired') if $params->{cache};

    $self->_method_cache_clear('is_expired');
    return $self->dateexpiry &&
        $self->dateexpiry !~ '^9999' &&
        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;

    my ($self, $params) = @_;
    $params //= {};

    return $self->_method_cache('has_overdues', $params) if $params->{cache};

    $self->_method_cache_clear('has_overdues', $params);
    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;




    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 );


    # Set cache
    $patron->is_expired({ cache => 1 });
    # Clear cache using _method_cache_clear
    $patron->_method_cache_clear('is_expired');
    is( $patron->_instance_cache_get('is_expired'), undef , 'Cache has been invalidated after calling _method_cache_clear' );

    $patron->delete;
};
- 

Return to bug 32476

Lines 845-851 Override Patron::dateexpiry to invalidate Patron::is_expired cache. Link Here

(-)a/Koha/Patron.pm (-6 / +6 lines)
845	sub dateexpiry {	845	sub dateexpiry {
846	my $self = shift @_;	846	my $self = shift @_;
847	if (@_) {	847	if (@_) {
848	$self->_instance_cache_clear('is_expired');	848	$self->_method_cache_clear('is_expired');
849	}	849	}
850	return $self->SUPER::dateexpiry(@_);	850	return $self->SUPER::dateexpiry(@_);
851	}	851	}
Lines 860-866 sub set { Link Here
860	my $self = shift @_;	860	my $self = shift @_;
861	my ($properties) = @_;	861	my ($properties) = @_;
862	if (exists $properties->{dateexpiry}) {	862	if (exists $properties->{dateexpiry}) {
863	$self->_instance_cache_clear('is_expired');	863	$self->_method_cache_clear('is_expired');
864	}	864	}
865	return $self->SUPER::set(@_);	865	return $self->SUPER::set(@_);
866	}	866	}
Lines 877-885 Returns 1 if the patron is expired or 0; Link Here
877	sub is_expired {	877	sub is_expired {
878	my ($self, $params) = @_;	878	my ($self, $params) = @_;
879	$params //= {};	879	$params //= {};
880	return $self->_accessor_cache('is_expired') if $params->{cache};	880	return $self->_method_cache('is_expired') if $params->{cache};
881		881
882	$self->_instance_cache_clear('is_expired');	882	$self->_method_cache_clear('is_expired');
883	return $self->dateexpiry &&	883	return $self->dateexpiry &&
884	$self->dateexpiry !~ '^9999' &&	884	$self->dateexpiry !~ '^9999' &&
885	dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;	885	dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
Lines 1137-1145 sub has_overdues { Link Here
1137	my ($self, $params) = @_;	1137	my ($self, $params) = @_;
1138	$params //= {};	1138	$params //= {};
1139		1139
1140	return $self->_accessor_cache('has_overdues') if $params->{cache};	1140	return $self->_method_cache('has_overdues', $params) if $params->{cache};
1141		1141
1142	$self->_instance_cache_clear('has_overdues');	1142	$self->_method_cache_clear('has_overdues', $params);
1143	my $date = dt_from_string();	1143	my $date = dt_from_string();
1144	my $dtf = Koha::Database->new->schema->storage->datetime_parser;	1144	my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1145	return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;	1145	return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;

Lines 275-284 subtest 'has_overdues' => sub { Link Here

(-)a/t/db_dependent/Koha/Patrons.t (-6 / +5 lines)
275	is( $retrieved_patron->has_overdues, 0, );	275	is( $retrieved_patron->has_overdues, 0, );
276		276
277	# Cache is set	277	# Cache is set
278	is( $retrieved_patron->has_overdues({ cache => 1}), 0, );	278	is( $retrieved_patron->has_overdues({ cache => 1 }), 0);
279	is( $retrieved_patron->_instance_cache_get('has_overdues'), 0, 'has_overdues cache has been set');	279	is( $retrieved_patron->_instance_cache_get('has_overdues'), 0, 'has_overdues cache has been set');
280	# Cache is used	280	# Cache is used
281	is( $retrieved_patron->has_overdues({ cache => 1}), 0, 'has_overdues cache is used');	281	is( $retrieved_patron->has_overdues({ cache => 1 }), 0, 'has_overdues cache is used');
282		282
283	$issue->delete();	283	$issue->delete();
284	my $yesterday = DateTime->today(time_zone => C4::Context->tz())->add( days => -1 );	284	my $yesterday = DateTime->today(time_zone => C4::Context->tz())->add( days => -1 );
Lines 339-347 subtest 'is_expired' => sub { Link Here
339		339
340	# Set cache	340	# Set cache
341	$patron->is_expired({ cache => 1 });	341	$patron->is_expired({ cache => 1 });
342	# Clear cache using public method accessor_cache_clear	342	# Clear cache using _method_cache_clear
343	$patron->accessor_cache_clear('is_expired');	343	$patron->_method_cache_clear('is_expired');
344	is( $patron->_instance_cache_get('is_expired'), undef , 'Cache has been invalidated after calling accessor_cache_clear' );	344	is( $patron->_instance_cache_get('is_expired'), undef , 'Cache has been invalidated after calling _method_cache_clear' );
345		345
346	$patron->delete;	346	$patron->delete;
347	};	347	};
348	-