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