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

(-)a/Koha/Object.pm (-15 / +44 lines)
Lines 25-30 use Mojo::JSON; Link Here
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();
(-)a/Koha/Patron.pm (-6 / +6 lines)
Lines 802-808 Override Patron::dateexpiry to invalidate Patron::is_expired cache. Link Here
802
sub dateexpiry {
802
sub dateexpiry {
803
    my $self = shift @_;
803
    my $self = shift @_;
804
    if (@_) {
804
    if (@_) {
805
        $self->_instance_cache_clear('is_expired');
805
        $self->_method_cache_clear('is_expired');
806
    }
806
    }
807
    return $self->SUPER::dateexpiry(@_);
807
    return $self->SUPER::dateexpiry(@_);
808
}
808
}
Lines 817-823 sub set { Link Here
817
    my $self = shift @_;
817
    my $self = shift @_;
818
    my ($properties) = @_;
818
    my ($properties) = @_;
819
    if (exists $properties->{dateexpiry}) {
819
    if (exists $properties->{dateexpiry}) {
820
        $self->_instance_cache_clear('is_expired');
820
        $self->_method_cache_clear('is_expired');
821
    }
821
    }
822
    return $self->SUPER::set(@_);
822
    return $self->SUPER::set(@_);
823
}
823
}
Lines 834-842 Returns 1 if the patron is expired or 0; Link Here
834
sub is_expired {
834
sub is_expired {
835
    my ($self, $params) = @_;
835
    my ($self, $params) = @_;
836
    $params //= {};
836
    $params //= {};
837
    return $self->_accessor_cache('is_expired') if $params->{cache};
837
    return $self->_method_cache('is_expired') if $params->{cache};
838
838
839
    $self->_instance_cache_clear('is_expired');
839
    $self->_method_cache_clear('is_expired');
840
    return $self->dateexpiry &&
840
    return $self->dateexpiry &&
841
        $self->dateexpiry !~ '^9999' &&
841
        $self->dateexpiry !~ '^9999' &&
842
        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
842
        dt_from_string( $self->dateexpiry ) < dt_from_string->truncate( to => 'day' ) ? 1 : 0;
Lines 1114-1122 sub has_overdues { Link Here
1114
    my ($self, $params) = @_;
1114
    my ($self, $params) = @_;
1115
    $params //= {};
1115
    $params //= {};
1116
1116
1117
    return $self->_accessor_cache('has_overdues') if $params->{cache};
1117
    return $self->_method_cache('has_overdues', $params) if $params->{cache};
1118
1118
1119
    $self->_instance_cache_clear('has_overdues');
1119
    $self->_method_cache_clear('has_overdues', $params);
1120
    my $date = dt_from_string();
1120
    my $date = dt_from_string();
1121
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1121
    my $dtf = Koha::Database->new->schema->storage->datetime_parser;
1122
    return $self->_result->issues->search({ date_due => { '<' => $dtf->format_datetime($date) } })->count;
1122
    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