Lines 18-24
package C4::Context;
Link Here
|
18 |
|
18 |
|
19 |
use strict; |
19 |
use strict; |
20 |
use warnings; |
20 |
use warnings; |
21 |
use vars qw($AUTOLOAD $context @context_stack $servers $memcached $ismemcached); |
21 |
use vars qw($AUTOLOAD $context @context_stack $memcached_servers); |
22 |
BEGIN { |
22 |
BEGIN { |
23 |
if ($ENV{'HTTP_USER_AGENT'}) { |
23 |
if ($ENV{'HTTP_USER_AGENT'}) { |
24 |
require CGI::Carp; |
24 |
require CGI::Carp; |
Lines 88-107
BEGIN {
Link Here
|
88 |
} # else there is no browser to send fatals to! |
88 |
} # else there is no browser to send fatals to! |
89 |
|
89 |
|
90 |
# Check if there are memcached servers set |
90 |
# Check if there are memcached servers set |
91 |
$servers = $ENV{'MEMCACHED_SERVERS'}; |
91 |
$memcached_servers = $ENV{'MEMCACHED_SERVERS'}; |
92 |
if ($servers) { |
92 |
# Load required libraries and create the memcached object |
93 |
# Load required libraries and create the memcached object |
93 |
require Cache::Memcached if $memcached_servers; |
94 |
require Cache::Memcached; |
|
|
95 |
$memcached = Cache::Memcached->new({ |
96 |
servers => [ $servers ], |
97 |
debug => 0, |
98 |
compress_threshold => 10_000, |
99 |
expire_time => 600, |
100 |
namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha' |
101 |
}); |
102 |
# Verify memcached available (set a variable and test the output) |
103 |
$ismemcached = $memcached->set('ismemcached','1'); |
104 |
} |
105 |
|
94 |
|
106 |
} |
95 |
} |
107 |
|
96 |
|
Lines 219-247
sub current {
Link Here
|
219 |
return $context; |
208 |
return $context; |
220 |
} |
209 |
} |
221 |
|
210 |
|
222 |
=head2 ismemcached |
211 |
sub _new_memcached { |
|
|
212 |
my $namespace = shift or die "No memcached namespace"; |
213 |
|
214 |
return unless $memcached_servers; |
215 |
return Cache::Memcached->new({ |
216 |
servers => [ $memcached_servers ], |
217 |
debug => 0, |
218 |
compress_threshold => 10_000, |
219 |
expire_time => 600, |
220 |
namespace => $namespace || $ENV{'MEMCACHED_NAMESPACE'} || 'koha' |
221 |
}); |
222 |
} |
223 |
# Verify memcached available (test the output) |
224 |
sub _ping_memcached { |
225 |
my $memcached = shift or croak "No memcached"; |
226 |
|
227 |
return $memcached->set('ismemcached','1'); |
228 |
} |
223 |
|
229 |
|
224 |
Returns the value of the $ismemcached variable (0/1) |
230 |
=head2 cache |
|
|
231 |
|
232 |
Returns the cache object or undef |
225 |
|
233 |
|
226 |
=cut |
234 |
=cut |
227 |
|
235 |
|
228 |
sub ismemcached { |
236 |
sub cache { |
229 |
return $ismemcached; |
237 |
my $self = shift; |
|
|
238 |
$self = $context unless ref ($self); |
239 |
|
240 |
return $self->{cache}; |
230 |
} |
241 |
} |
231 |
|
242 |
|
232 |
=head2 memcached |
243 |
=head2 memcached |
233 |
|
244 |
|
234 |
If $ismemcached is true, returns the $memcache variable. |
245 |
Returns the memcached object or undef |
235 |
Returns undef otherwise |
246 |
|
|
|
247 |
=head2 ismemcached |
236 |
|
248 |
|
237 |
=cut |
249 |
=cut |
238 |
|
250 |
|
239 |
sub memcached { |
251 |
sub memcached { |
240 |
if ($ismemcached) { |
252 |
my $self = shift; |
241 |
return $memcached; |
253 |
$self = $context unless ref ($self); |
242 |
} else { |
254 |
|
243 |
return; |
255 |
my $memcached = $self->{memcached} or return; |
244 |
} |
256 |
return _ping_memcached($memcached) ? $memcached : undef; |
|
|
257 |
} |
258 |
|
259 |
sub ismemcached { |
260 |
my $self = shift; |
261 |
return $self->memcached; |
245 |
} |
262 |
} |
246 |
|
263 |
|
247 |
sub db_driver { |
264 |
sub db_driver { |
Lines 285-294
sub import {
Link Here
|
285 |
# default context already exists? |
302 |
# default context already exists? |
286 |
return if $context; |
303 |
return if $context; |
287 |
|
304 |
|
288 |
if ($ismemcached) { |
305 |
return if $config_file && $config_file eq ":no_config"; |
|
|
306 |
|
307 |
my $memcached = _new_memcached($ENV{'MEMCACHED_NAMESPACE'} || 'koha'); |
308 |
if ($memcached) { |
289 |
# retrieve from memcached |
309 |
# retrieve from memcached |
290 |
if (my $self = $memcached->get('kohaconf')) { |
310 |
if ($context = $memcached->get('kohaconf')) { |
291 |
$context = $self; |
311 |
$context->{memcached} = $memcached; |
292 |
return; |
312 |
return; |
293 |
} |
313 |
} |
294 |
} |
314 |
} |
Lines 315-329
sub import {
Link Here
|
315 |
} |
335 |
} |
316 |
|
336 |
|
317 |
# no ? so load it! |
337 |
# no ? so load it! |
318 |
return if $config_file && $config_file eq ":no_config"; |
338 |
$context = $pkg->new($config_file) or return; |
319 |
my $new_ctx = __PACKAGE__->new($config_file); |
339 |
if ( $memcached && _ping_memcached($memcached) ) { |
320 |
return unless $new_ctx; |
340 |
$context->{memcached} = $memcached; |
321 |
|
341 |
$memcached->set('kohaconf',$context); |
322 |
# if successfully loaded, use it by default |
|
|
323 |
$context = $new_ctx; |
324 |
|
325 |
if ($ismemcached) { |
326 |
$memcached->set('kohaconf',$new_ctx); |
327 |
} |
342 |
} |
328 |
} |
343 |
} |
329 |
|
344 |
|
Lines 365-370
sub new {
Link Here
|
365 |
my $class = shift; |
380 |
my $class = shift; |
366 |
my $conf_fname = shift or croak "No conf"; |
381 |
my $conf_fname = shift or croak "No conf"; |
367 |
my $namespace = shift; |
382 |
my $namespace = shift; |
|
|
383 |
my $cache = shift; |
368 |
|
384 |
|
369 |
my $self = XMLin( |
385 |
my $self = XMLin( |
370 |
$conf_fname, |
386 |
$conf_fname, |
Lines 378-384
sub new {
Link Here
|
378 |
$self->{config_file} = $conf_fname; |
394 |
$self->{config_file} = $conf_fname; |
379 |
$self->{namespace} = $namespace; |
395 |
$self->{namespace} = $namespace; |
380 |
$self->{use_syspref_cache} = 1; |
396 |
$self->{use_syspref_cache} = 1; |
381 |
$self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); |
397 |
$self->{cache} = Koha::Cache->new({namespace => $namespace}); |
|
|
398 |
if ($memcached_servers) { |
399 |
$self->{memcached} = _new_memcached($namespace); |
400 |
} |
382 |
|
401 |
|
383 |
$self->{"Zconn"} = undef; # Zebra Connections |
402 |
$self->{"Zconn"} = undef; # Zebra Connections |
384 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
403 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
Lines 556-562
sub preference {
Link Here
|
556 |
$var = lc $var; |
575 |
$var = lc $var; |
557 |
|
576 |
|
558 |
my $cached_var = $self->{use_syspref_cache} |
577 |
my $cached_var = $self->{use_syspref_cache} |
559 |
? $self->{syspref_cache}->get_from_cache("syspref_$var") |
578 |
? $self->cache->get_from_cache("syspref_$var") |
560 |
: undef; |
579 |
: undef; |
561 |
return $cached_var if defined $cached_var; |
580 |
return $cached_var if defined $cached_var; |
562 |
|
581 |
|
Lines 570-576
sub preference {
Link Here
|
570 |
} |
589 |
} |
571 |
|
590 |
|
572 |
if ( $self->{use_syspref_cache} ) { |
591 |
if ( $self->{use_syspref_cache} ) { |
573 |
$self->{syspref_cache}->set_in_cache("syspref_$var", $value); |
592 |
$self->cache->set_in_cache("syspref_$var", $value); |
|
|
593 |
$self->{sysprefs}{$var} = $value if $self; |
574 |
} |
594 |
} |
575 |
return $value; |
595 |
return $value; |
576 |
} |
596 |
} |
Lines 629-635
sub clear_syspref_cache {
Link Here
|
629 |
my ($self) = @_; |
649 |
my ($self) = @_; |
630 |
$self = $context unless ref $self; |
650 |
$self = $context unless ref $self; |
631 |
return unless $self->{use_syspref_cache}; |
651 |
return unless $self->{use_syspref_cache}; |
632 |
$self->{syspref_cache}->flush_all; |
652 |
$self->cache->flush_all; |
633 |
} |
653 |
} |
634 |
|
654 |
|
635 |
=head2 set_preference |
655 |
=head2 set_preference |
Lines 682-688
sub set_preference {
Link Here
|
682 |
} |
702 |
} |
683 |
|
703 |
|
684 |
if ( $self->{use_syspref_cache} ) { |
704 |
if ( $self->{use_syspref_cache} ) { |
685 |
$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); |
705 |
$self->cache->set_in_cache( "syspref_$variable", $value ); |
686 |
} |
706 |
} |
687 |
|
707 |
|
688 |
return $syspref; |
708 |
return $syspref; |
Lines 704-710
sub delete_preference {
Link Here
|
704 |
|
724 |
|
705 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
725 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
706 |
if ( $self->{use_syspref_cache} ) { |
726 |
if ( $self->{use_syspref_cache} ) { |
707 |
$self->{syspref_cache}->clear_from_cache("syspref_$var"); |
727 |
$self->cache->clear_from_cache("syspref_$var"); |
708 |
} |
728 |
} |
709 |
|
729 |
|
710 |
return 1; |
730 |
return 1; |