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