|
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"; |
| 223 |
|
226 |
|
| 224 |
Returns the value of the $ismemcached variable (0/1) |
227 |
return $memcached->set('ismemcached','1'); |
|
|
228 |
} |
| 229 |
|
| 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; |
|
|
312 |
$context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); |
| 292 |
return; |
313 |
return; |
| 293 |
} |
314 |
} |
| 294 |
} |
315 |
} |
|
Lines 315-330
sub import {
Link Here
|
| 315 |
} |
336 |
} |
| 316 |
|
337 |
|
| 317 |
# no ? so load it! |
338 |
# no ? so load it! |
| 318 |
return if $config_file && $config_file eq ":no_config"; |
339 |
$context = $pkg->_new($config_file) or return; |
| 319 |
my $new_ctx = __PACKAGE__->new($config_file); |
340 |
if ( $memcached && _ping_memcached($memcached) ) { |
| 320 |
return unless $new_ctx; |
341 |
$memcached->set('kohaconf',$context); |
| 321 |
|
342 |
# Canot serialize cache objects |
| 322 |
# if successfully loaded, use it by default |
343 |
$context->{memcached} = $memcached; |
| 323 |
$context = $new_ctx; |
|
|
| 324 |
|
| 325 |
if ($ismemcached) { |
| 326 |
$memcached->set('kohaconf',$new_ctx); |
| 327 |
} |
344 |
} |
|
|
345 |
$context->{cache} = Koha::Cache->new({namespace => $context->{namespace}}); |
| 328 |
} |
346 |
} |
| 329 |
|
347 |
|
| 330 |
use Scalar::Util qw(openhandle); |
348 |
use Scalar::Util qw(openhandle); |
|
Lines 366-371
sub new {
Link Here
|
| 366 |
my $conf_fname = shift or croak "No conf"; |
384 |
my $conf_fname = shift or croak "No conf"; |
| 367 |
my $namespace = shift; |
385 |
my $namespace = shift; |
| 368 |
|
386 |
|
|
|
387 |
my $self = $class->_new($conf_fname, $namespace); |
| 388 |
|
| 389 |
if ($memcached_servers) { |
| 390 |
$self->{memcached} = _new_memcached($namespace); |
| 391 |
} |
| 392 |
$self->{cache} = Koha::Cache->new({namespace => $namespace}); |
| 393 |
|
| 394 |
return $self; |
| 395 |
} |
| 396 |
|
| 397 |
sub _new { |
| 398 |
my $class = shift; |
| 399 |
my $conf_fname = shift or croak "No conf"; |
| 400 |
my $namespace = shift; |
| 401 |
|
| 369 |
my $self = XMLin( |
402 |
my $self = XMLin( |
| 370 |
$conf_fname, |
403 |
$conf_fname, |
| 371 |
keyattr => ['id'], |
404 |
keyattr => ['id'], |
|
Lines 378-384
sub new {
Link Here
|
| 378 |
$self->{config_file} = $conf_fname; |
411 |
$self->{config_file} = $conf_fname; |
| 379 |
$self->{namespace} = $namespace; |
412 |
$self->{namespace} = $namespace; |
| 380 |
$self->{use_syspref_cache} = 1; |
413 |
$self->{use_syspref_cache} = 1; |
| 381 |
$self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); |
|
|
| 382 |
|
414 |
|
| 383 |
$self->{"Zconn"} = undef; # Zebra Connections |
415 |
$self->{"Zconn"} = undef; # Zebra Connections |
| 384 |
$self->{"userenv"} = undef; # User env |
416 |
$self->{"userenv"} = undef; # User env |
|
Lines 558-564
sub preference {
Link Here
|
| 558 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
590 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
| 559 |
|
591 |
|
| 560 |
my $cached_var = $self->{use_syspref_cache} |
592 |
my $cached_var = $self->{use_syspref_cache} |
| 561 |
? $self->{syspref_cache}->get_from_cache("syspref_$var") |
593 |
? $self->cache->get_from_cache("syspref_$var") |
| 562 |
: undef; |
594 |
: undef; |
| 563 |
return $cached_var if defined $cached_var; |
595 |
return $cached_var if defined $cached_var; |
| 564 |
|
596 |
|
|
Lines 567-573
sub preference {
Link Here
|
| 567 |
my $value = $syspref ? $syspref->value() : undef; |
599 |
my $value = $syspref ? $syspref->value() : undef; |
| 568 |
|
600 |
|
| 569 |
if ( $self->{use_syspref_cache} ) { |
601 |
if ( $self->{use_syspref_cache} ) { |
| 570 |
$self->{syspref_cache}->set_in_cache("syspref_$var", $value); |
602 |
$self->cache->set_in_cache("syspref_$var", $value); |
|
|
603 |
$self->{sysprefs}{$var} = $value if $self; |
| 571 |
} |
604 |
} |
| 572 |
return $value; |
605 |
return $value; |
| 573 |
} |
606 |
} |
|
Lines 608-615
used with Plack and other persistent environments.
Link Here
|
| 608 |
sub disable_syspref_cache { |
641 |
sub disable_syspref_cache { |
| 609 |
my ($self) = @_; |
642 |
my ($self) = @_; |
| 610 |
$self = $context unless ref $self; |
643 |
$self = $context unless ref $self; |
| 611 |
$self->{use_syspref_cache} = 0; |
|
|
| 612 |
$self->clear_syspref_cache(); |
644 |
$self->clear_syspref_cache(); |
|
|
645 |
$self->{use_syspref_cache} = 0; |
| 613 |
} |
646 |
} |
| 614 |
|
647 |
|
| 615 |
=head2 clear_syspref_cache |
648 |
=head2 clear_syspref_cache |
|
Lines 626-632
sub clear_syspref_cache {
Link Here
|
| 626 |
my ($self) = @_; |
659 |
my ($self) = @_; |
| 627 |
$self = $context unless ref $self; |
660 |
$self = $context unless ref $self; |
| 628 |
return unless $self->{use_syspref_cache}; |
661 |
return unless $self->{use_syspref_cache}; |
| 629 |
$self->{syspref_cache}->flush_all; |
662 |
$self->cache->flush_all; |
| 630 |
} |
663 |
} |
| 631 |
|
664 |
|
| 632 |
=head2 set_preference |
665 |
=head2 set_preference |
|
Lines 679-685
sub set_preference {
Link Here
|
| 679 |
} |
712 |
} |
| 680 |
|
713 |
|
| 681 |
if ( $self->{use_syspref_cache} ) { |
714 |
if ( $self->{use_syspref_cache} ) { |
| 682 |
$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); |
715 |
$self->cache->set_in_cache( "syspref_$variable", $value ); |
| 683 |
} |
716 |
} |
| 684 |
|
717 |
|
| 685 |
return $syspref; |
718 |
return $syspref; |
|
Lines 701-707
sub delete_preference {
Link Here
|
| 701 |
|
734 |
|
| 702 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
735 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
| 703 |
if ( $self->{use_syspref_cache} ) { |
736 |
if ( $self->{use_syspref_cache} ) { |
| 704 |
$self->{syspref_cache}->clear_from_cache("syspref_$var"); |
737 |
$self->cache->clear_from_cache("syspref_$var"); |
| 705 |
} |
738 |
} |
| 706 |
|
739 |
|
| 707 |
return 1; |
740 |
return 1; |