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