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

(-)a/Koha/Object.pm (-15 / +44 lines)
Lines 26-31 use Scalar::Util qw( blessed looks_like_number ); Link Here
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 DateTime::Format::MySQL;
28
use DateTime::Format::MySQL;
29
use Data::Dumper;
30
use Digest::MD5 qw( md5_hex );
29
31
30
use Koha::Database;
32
use Koha::Database;
31
use Koha::DateTime::Format::RFC3339;
33
use Koha::DateTime::Format::RFC3339;
Lines 98-107 my $instance_cache_key = Koha::Object->_instance_cache_key($key); Link Here
98
100
99
sub _instance_cache_key {
101
sub _instance_cache_key {
100
    my ($self, $key) = @_;
102
    my ($self, $key) = @_;
101
    warn "_instance_cache_key must not be called on object that has not been stored" unless $self->id;
103
    croak "_instance_cache_key must not be called on object that has not been stored" unless $self->id;
102
    return $self->_type . ':' . $self->id  . ':' . $key;
104
    return $self->_type . ':' . $self->id  . ':' . $key;
103
}
105
}
104
106
107
=head3 Koha::Object->_method_cache_key();
108
109
my $method_cache_key = Koha::Object->_method_cache_key($key, @args);
110
111
=cut
112
113
sub _method_cache_key {
114
    my ($self, $method, @args) = @_;
115
    if (@args) {
116
        if(ref $args[0] eq 'HASH') {
117
            if (!%{$args[0]} && @args == 1) {
118
                return $method;
119
            }
120
        }
121
        else {
122
            croak "First argument to _instance_cache_key must be hashref";
123
        }
124
        local $Data::Dumper::Sortkeys = 1;
125
        return $method . md5_hex(Dumper(\@args));
126
    }
127
    return $method;
128
}
129
105
=head3 Koha::Object->_instance_cache_get();
130
=head3 Koha::Object->_instance_cache_get();
106
131
107
my $value = Koha::Object->_instance_cache_get($cache_key);
132
my $value = Koha::Object->_instance_cache_get($cache_key);
Lines 125-131 Koha::Object->_instance_cache_set($cache_key, $value); Link Here
125
sub _instance_cache_set {
150
sub _instance_cache_set {
126
    my ($self, $key, $value) = @_;
151
    my ($self, $key, $value) = @_;
127
    return unless $self->id;
152
    return unless $self->id;
128
    $self->{_cache}->{$key} = $value;
129
    return Koha::Cache::Memory::Lite->get_instance->set_in_cache(
153
    return Koha::Cache::Memory::Lite->get_instance->set_in_cache(
130
        $self->_instance_cache_key($key),
154
        $self->_instance_cache_key($key),
131
        $value
155
        $value
Lines 135-141 sub _instance_cache_set { Link Here
135
=head3 Koha::Object->_instance_cache_clear($cache_key);
159
=head3 Koha::Object->_instance_cache_clear($cache_key);
136
160
137
Koha::Object->_instance_cache_clear($cache_key);
161
Koha::Object->_instance_cache_clear($cache_key);
138
Koha::Object->_instance_cache_clear();
139
162
140
=cut
163
=cut
141
164
Lines 147-180 sub _instance_cache_clear { Link Here
147
    )
170
    )
148
}
171
}
149
172
150
=head3 Koha::Object->_accessor_cache($method_name);
173
=head3 Koha::Object->_method_cache($method_name);
151
174
152
my $value = Koha::Object->_accessor_cache($method_name);
175
my $value = Koha::Object->_method_cache($method_name, @args);
153
176
154
=cut
177
=cut
155
178
156
sub _accessor_cache {
179
sub _method_cache {
157
    my ($self, $method_name) = @_;
180
    my ($self, $method_name, @args) = @_;
158
181
159
    my $value = $self->_instance_cache_get($method_name);
182
    my $cache_key = $self->_method_cache_key($method_name, @args);
183
    my $value = $self->_instance_cache_get($cache_key);
160
184
161
    return $value if defined $value;
185
    return $value if defined $value;
162
186
163
    $value = $self->$method_name();
187
    if (@args) {
164
    $self->_instance_cache_set($method_name, $value);
188
        delete $args[0]->{cache};
189
    }
190
    $value = $self->$method_name(@args);
191
192
    $self->_instance_cache_set($cache_key, $value);
165
193
166
    return $value;
194
    return $value;
167
}
195
}
168
196
169
=head3 Koha::Object->accessor_cache_clear($method_name);
197
=head3 Koha::Object->_method_cache_clear($method_name, @args);
170
198
171
Koha::Object->accessor_cache_clear($method_name);
199
Koha::Object->_method_cache_clear($method_name, @args);
172
200
173
=cut
201
=cut
174
202
175
sub accessor_cache_clear {
203
sub _method_cache_clear {
176
    my ($self, $method_name) = @_;
204
    my ($self, $method_name, @args) = @_;
177
    $self->_instance_cache_clear($method_name);
205
    my $cache_key = $self->_method_cache_key($method_name, @args);
206
    $self->_instance_cache_clear($cache_key);
178
}
207
}
179
208
180
=head3 Koha::Object->_new_from_dbic();
209
=head3 Koha::Object->_new_from_dbic();
(-)a/Koha/Patron.pm (-6 / +6 lines)
Lines 893-899 Override Patron::dateexpiry to invalidate Patron::is_expired cache. Link Here
893
sub dateexpiry {
893
sub dateexpiry {
894
    my $self = shift @_;
894
    my $self = shift @_;
895
    if (@_) {
895
    if (@_) {
896
        $self->_instance_cache_clear('is_expired');
896
        $self->_method_cache_clear('is_expired');
897
    }
897
    }
898
    return $self->SUPER::dateexpiry(@_);
898
    return $self->SUPER::dateexpiry(@_);
899
}
899
}
Lines 908-914 sub set { Link Here
908
    my $self = shift @_;
908
    my $self = shift @_;
909
    my ($properties) = @_;
909
    my ($properties) = @_;
910
    if (exists $properties->{dateexpiry}) {
910
    if (exists $properties->{dateexpiry}) {
911
        $self->_instance_cache_clear('is_expired');
911
        $self->_method_cache_clear('is_expired');
912
    }
912
    }
913
    return $self->SUPER::set(@_);
913
    return $self->SUPER::set(@_);
914
}
914
}
Lines 925-933 Returns 1 if the patron is expired or 0; Link Here
925
sub is_expired {
925
sub is_expired {
926
    my ($self, $params) = @_;
926
    my ($self, $params) = @_;
927
    $params //= {};
927
    $params //= {};
928
    return $self->_accessor_cache('is_expired') if $params->{cache};
928
    return $self->_method_cache('is_expired') if $params->{cache};
929
929
930
    $self->_instance_cache_clear('is_expired');
930
    $self->_method_cache_clear('is_expired');
931
    return $self->dateexpiry &&
931
    return $self->dateexpiry &&
932
        $self->dateexpiry !~ '^9999' &&
932
        $self->dateexpiry !~ '^9999' &&
933
        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
933
        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
Lines 1185-1193 sub has_overdues { Link Here
1185
    my ($self, $params) = @_;
1185
    my ($self, $params) = @_;
1186
    $params //= {};
1186
    $params //= {};
1187
1187
1188
    return $self->_accessor_cache('has_overdues') if $params->{cache};
1188
    return $self->_method_cache('has_overdues', $params) if $params->{cache};
1189
1189
1190
    $self->_instance_cache_clear('has_overdues');
1190
    $self->_method_cache_clear('has_overdues', $params);
1191
    my $date = dt_from_string();
1191
    my $date = dt_from_string();
1192
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1192
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1193
    return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1193
    return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
(-)a/t/db_dependent/Koha/Patrons.t (-6 / +5 lines)
Lines 275-284 subtest 'has_overdues' => sub { Link Here
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
- 

Return to bug 32476