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