|
Lines 31-37
BEGIN {
Link Here
|
| 31 |
eval {C4::Context->dbh();}; |
31 |
eval {C4::Context->dbh();}; |
| 32 |
if ($@){ |
32 |
if ($@){ |
| 33 |
$debug_level = 1; |
33 |
$debug_level = 1; |
| 34 |
} |
34 |
} |
| 35 |
else { |
35 |
else { |
| 36 |
$debug_level = C4::Context->preference("DebugLevel"); |
36 |
$debug_level = C4::Context->preference("DebugLevel"); |
| 37 |
} |
37 |
} |
|
Lines 49-55
BEGIN {
Link Here
|
| 49 |
# a little example table with various version info"; |
49 |
# a little example table with various version info"; |
| 50 |
print " |
50 |
print " |
| 51 |
<h1>Koha error</h1> |
51 |
<h1>Koha error</h1> |
| 52 |
<p>The following fatal error has occurred:</p> |
52 |
<p>The following fatal error has occurred:</p> |
| 53 |
<pre><code>$msg</code></pre> |
53 |
<pre><code>$msg</code></pre> |
| 54 |
<table> |
54 |
<table> |
| 55 |
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr> |
55 |
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr> |
|
Lines 63-73
BEGIN {
Link Here
|
| 63 |
} elsif ($debug_level eq "1"){ |
63 |
} elsif ($debug_level eq "1"){ |
| 64 |
print " |
64 |
print " |
| 65 |
<h1>Koha error</h1> |
65 |
<h1>Koha error</h1> |
| 66 |
<p>The following fatal error has occurred:</p> |
66 |
<p>The following fatal error has occurred:</p> |
| 67 |
<pre><code>$msg</code></pre>"; |
67 |
<pre><code>$msg</code></pre>"; |
| 68 |
} else { |
68 |
} else { |
| 69 |
print "<p>production mode - trapped fatal error</p>"; |
69 |
print "<p>production mode - trapped fatal error</p>"; |
| 70 |
} |
70 |
} |
| 71 |
print "</body></html>"; |
71 |
print "</body></html>"; |
| 72 |
} |
72 |
} |
| 73 |
#CGI::Carp::set_message(\&handle_errors); |
73 |
#CGI::Carp::set_message(\&handle_errors); |
|
Lines 112-117
use Koha::Cache;
Link Here
|
| 112 |
use POSIX (); |
112 |
use POSIX (); |
| 113 |
use DateTime::TimeZone; |
113 |
use DateTime::TimeZone; |
| 114 |
use Module::Load::Conditional qw(can_load); |
114 |
use Module::Load::Conditional qw(can_load); |
|
|
115 |
use Data::Dumper; |
| 115 |
use Carp; |
116 |
use Carp; |
| 116 |
|
117 |
|
| 117 |
use C4::Boolean; |
118 |
use C4::Boolean; |
|
Lines 179-188
environment variable to the pathname of a configuration file to use.
Link Here
|
| 179 |
# file (/etc/koha/koha-conf.xml). |
180 |
# file (/etc/koha/koha-conf.xml). |
| 180 |
# dbh |
181 |
# dbh |
| 181 |
# A handle to the appropriate database for this context. |
182 |
# A handle to the appropriate database for this context. |
| 182 |
# dbh_stack |
|
|
| 183 |
# Used by &set_dbh and &restore_dbh to hold other database |
| 184 |
# handles for this context. |
| 185 |
# Zconn |
| 186 |
# A connection object for the Zebra server |
183 |
# A connection object for the Zebra server |
| 187 |
|
184 |
|
| 188 |
# Koha's main configuration file koha-conf.xml |
185 |
# Koha's main configuration file koha-conf.xml |
|
Lines 191-197
environment variable to the pathname of a configuration file to use.
Link Here
|
| 191 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
188 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
| 192 |
# 2. Path supplied in KOHA_CONF environment variable. |
189 |
# 2. Path supplied in KOHA_CONF environment variable. |
| 193 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
190 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
| 194 |
# as value has changed from its default of |
191 |
# as value has changed from its default of |
| 195 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
192 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
| 196 |
# when Koha is installed in 'standard' or 'single' |
193 |
# when Koha is installed in 'standard' or 'single' |
| 197 |
# mode. |
194 |
# mode. |
|
Lines 201-252
environment variable to the pathname of a configuration file to use.
Link Here
|
| 201 |
|
198 |
|
| 202 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
199 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
| 203 |
# Default config file, if none is specified |
200 |
# Default config file, if none is specified |
| 204 |
|
201 |
|
| 205 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
202 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
| 206 |
# path to config file set by installer |
203 |
# path to config file set by installer |
| 207 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
204 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
| 208 |
# when Koha is installed in 'standard' or 'single' |
205 |
# when Koha is installed in 'standard' or 'single' |
| 209 |
# mode. If Koha was installed in 'dev' mode, |
206 |
# mode. If Koha was installed in 'dev' mode, |
| 210 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
207 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
| 211 |
# developers should set the KOHA_CONF environment variable |
208 |
# developers should set the KOHA_CONF environment variable |
| 212 |
|
|
|
| 213 |
$context = undef; # Initially, no context is set |
| 214 |
@context_stack = (); # Initially, no saved contexts |
| 215 |
|
| 216 |
|
| 217 |
=head2 read_config_file |
| 218 |
|
| 219 |
Reads the specified Koha config file. |
| 220 |
|
| 221 |
Returns an object containing the configuration variables. The object's |
| 222 |
structure is a bit complex to the uninitiated ... take a look at the |
| 223 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
| 224 |
here are a few examples that may give you what you need: |
| 225 |
|
209 |
|
| 226 |
The simple elements nested within the <config> element: |
210 |
@context_stack = (); # Initially, no saved contexts |
| 227 |
|
211 |
|
| 228 |
my $pass = $koha->{'config'}->{'pass'}; |
212 |
=head2 current |
| 229 |
|
213 |
|
| 230 |
The <listen> elements: |
214 |
Returns the current context |
| 231 |
|
|
|
| 232 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
| 233 |
|
| 234 |
The elements nested within the <server> element: |
| 235 |
|
| 236 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
| 237 |
|
| 238 |
Returns undef in case of error. |
| 239 |
|
215 |
|
| 240 |
=cut |
216 |
=cut |
| 241 |
|
217 |
|
| 242 |
sub read_config_file { # Pass argument naming config file to read |
218 |
sub current { |
| 243 |
my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); |
219 |
return $context; |
| 244 |
|
|
|
| 245 |
if ($ismemcached) { |
| 246 |
$memcached->set('kohaconf',$koha); |
| 247 |
} |
| 248 |
|
| 249 |
return $koha; # Return value: ref-to-hash holding the configuration |
| 250 |
} |
220 |
} |
| 251 |
|
221 |
|
| 252 |
=head2 ismemcached |
222 |
=head2 ismemcached |
|
Lines 274-279
sub memcached {
Link Here
|
| 274 |
} |
244 |
} |
| 275 |
} |
245 |
} |
| 276 |
|
246 |
|
|
|
247 |
sub db_driver { |
| 248 |
my $self = shift; |
| 249 |
|
| 250 |
$self = $context unless ref ($self); |
| 251 |
return unless $self; |
| 252 |
|
| 253 |
return $self->{db_driver}; |
| 254 |
} |
| 255 |
|
| 277 |
=head2 db_scheme2dbi |
256 |
=head2 db_scheme2dbi |
| 278 |
|
257 |
|
| 279 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
258 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
|
Lines 294-325
sub import {
Link Here
|
| 294 |
# Create the default context ($C4::Context::Context) |
273 |
# Create the default context ($C4::Context::Context) |
| 295 |
# the first time the module is called |
274 |
# the first time the module is called |
| 296 |
# (a config file can be optionaly passed) |
275 |
# (a config file can be optionaly passed) |
|
|
276 |
# If ":no_config" is passed, no config load will be attempted |
| 277 |
# Config file defaults to either the file given by the $KOHA_CONF |
| 278 |
# environment variable, or /etc/koha/koha-conf.xml. |
| 279 |
# It saves the context values in the declared memcached server(s) |
| 280 |
# if currently available and uses those values until them expire and |
| 281 |
# re-reads them. |
| 282 |
|
| 283 |
my ($pkg,$config_file) = @_ ; |
| 297 |
|
284 |
|
| 298 |
# default context already exists? |
285 |
# default context already exists? |
| 299 |
return if $context; |
286 |
return if $context; |
| 300 |
|
287 |
|
|
|
288 |
if ($ismemcached) { |
| 289 |
# retrieve from memcached |
| 290 |
if (my $self = $memcached->get('kohaconf')) { |
| 291 |
$context = $self; |
| 292 |
return; |
| 293 |
} |
| 294 |
} |
| 295 |
|
| 296 |
# check that the specified config file exists and is not empty |
| 297 |
undef $config_file if defined $config_file && |
| 298 |
!( ref($config_file) || openhandle($config_file) || -s $config_file ); |
| 299 |
# Figure out a good config file to load if none was specified. |
| 300 |
if (!defined($config_file)) |
| 301 |
{ |
| 302 |
# If the $KOHA_CONF environment variable is set, use |
| 303 |
# that. Otherwise, use the built-in default. |
| 304 |
if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s $ENV{"KOHA_CONF"}) { |
| 305 |
$config_file = $ENV{"KOHA_CONF"}; |
| 306 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
| 307 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
| 308 |
# regex to anything else -- don't want installer to rewrite it |
| 309 |
$config_file = $INSTALLED_CONFIG_FNAME; |
| 310 |
} elsif (-s CONFIG_FNAME) { |
| 311 |
$config_file = CONFIG_FNAME; |
| 312 |
} else { |
| 313 |
die "unable to locate Koha configuration file koha-conf.xml"; |
| 314 |
} |
| 315 |
} |
| 316 |
|
| 301 |
# no ? so load it! |
317 |
# no ? so load it! |
| 302 |
my ($pkg,$config_file) = @_ ; |
318 |
return if $config_file && $config_file eq ":no_config"; |
| 303 |
my $new_ctx = __PACKAGE__->new($config_file); |
319 |
my $new_ctx = __PACKAGE__->new($config_file); |
| 304 |
return unless $new_ctx; |
320 |
return unless $new_ctx; |
| 305 |
|
321 |
|
| 306 |
# if successfully loaded, use it by default |
322 |
# if successfully loaded, use it by default |
| 307 |
$new_ctx->set_context; |
323 |
$context = $new_ctx; |
| 308 |
1; |
324 |
|
|
|
325 |
if ($ismemcached) { |
| 326 |
$memcached->set('kohaconf',$new_ctx); |
| 327 |
} |
| 309 |
} |
328 |
} |
| 310 |
|
329 |
|
|
|
330 |
use Scalar::Util qw(openhandle); |
| 311 |
=head2 new |
331 |
=head2 new |
| 312 |
|
332 |
|
| 313 |
$context = new C4::Context; |
|
|
| 314 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
333 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
| 315 |
|
334 |
|
| 316 |
Allocates a new context. Initializes the context from the specified |
335 |
Allocates a new context. Initializes the context from the specified |
| 317 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
336 |
file. |
| 318 |
environment variable, or F</etc/koha/koha-conf.xml>. |
|
|
| 319 |
|
337 |
|
| 320 |
It saves the koha-conf.xml values in the declared memcached server(s) |
338 |
XML structure is a bit complex to the uninitiated ... take a look at the |
| 321 |
if currently available and uses those values until them expire and |
339 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
| 322 |
re-reads them. |
340 |
here are a few examples that may give you what you need: |
|
|
341 |
|
| 342 |
The simple elements nested within the <config> element: |
| 343 |
|
| 344 |
my $pass = $koha->{'config'}->{'pass'}; |
| 345 |
|
| 346 |
The <listen> elements: |
| 347 |
|
| 348 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
| 349 |
|
| 350 |
The elements nested within the <server> element: |
| 351 |
|
| 352 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
| 353 |
|
| 354 |
Returns undef in case of error. |
| 323 |
|
355 |
|
| 324 |
C<&new> does not set this context as the new default context; for |
356 |
C<&new> does not set this context as the new default context; for |
| 325 |
that, use C<&set_context>. |
357 |
that, use C<&set_context>. |
|
Lines 331-376
that, use C<&set_context>.
Link Here
|
| 331 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
363 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
| 332 |
sub new { |
364 |
sub new { |
| 333 |
my $class = shift; |
365 |
my $class = shift; |
| 334 |
my $conf_fname = shift; # Config file to load |
366 |
my $conf_fname = shift or croak "No conf"; |
| 335 |
my $self = {}; |
367 |
my $namespace = shift; |
| 336 |
|
368 |
|
| 337 |
# check that the specified config file exists and is not empty |
369 |
my $self = XMLin( |
| 338 |
undef $conf_fname unless |
370 |
$conf_fname, |
| 339 |
(defined $conf_fname && -s $conf_fname); |
371 |
keyattr => ['id'], |
| 340 |
# Figure out a good config file to load if none was specified. |
372 |
forcearray => ['listen', 'server', 'serverinfo'], |
| 341 |
if (!defined($conf_fname)) |
373 |
suppressempty => '', |
| 342 |
{ |
374 |
); |
| 343 |
# If the $KOHA_CONF environment variable is set, use |
375 |
die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) |
| 344 |
# that. Otherwise, use the built-in default. |
376 |
unless ref($self) && $self->{"config"}; |
| 345 |
if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) { |
377 |
|
| 346 |
$conf_fname = $ENV{"KOHA_CONF"}; |
378 |
$self->{config_file} = $conf_fname; |
| 347 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
379 |
$self->{namespace} = $namespace; |
| 348 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
380 |
$self->{use_syspref_cache} = 1; |
| 349 |
# regex to anything else -- don't want installer to rewrite it |
381 |
$self->{syspref_cache} = Koha::Cache->new({namespace => $namespace}); |
| 350 |
$conf_fname = $INSTALLED_CONFIG_FNAME; |
|
|
| 351 |
} elsif (-s CONFIG_FNAME) { |
| 352 |
$conf_fname = CONFIG_FNAME; |
| 353 |
} else { |
| 354 |
warn "unable to locate Koha configuration file koha-conf.xml"; |
| 355 |
return; |
| 356 |
} |
| 357 |
} |
| 358 |
|
| 359 |
if ($ismemcached) { |
| 360 |
# retrieve from memcached |
| 361 |
$self = $memcached->get('kohaconf'); |
| 362 |
if (not defined $self) { |
| 363 |
# not in memcached yet |
| 364 |
$self = read_config_file($conf_fname); |
| 365 |
} |
| 366 |
} else { |
| 367 |
# non-memcached env, read from file |
| 368 |
$self = read_config_file($conf_fname); |
| 369 |
} |
| 370 |
|
| 371 |
$self->{"config_file"} = $conf_fname; |
| 372 |
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |
| 373 |
return if !defined($self->{"config"}); |
| 374 |
|
382 |
|
| 375 |
$self->{"Zconn"} = undef; # Zebra Connections |
383 |
$self->{"Zconn"} = undef; # Zebra Connections |
| 376 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
384 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
|
Lines 386-392
sub new {
Link Here
|
| 386 |
|
394 |
|
| 387 |
=head2 set_context |
395 |
=head2 set_context |
| 388 |
|
396 |
|
| 389 |
$context = new C4::Context; |
|
|
| 390 |
$context->set_context(); |
397 |
$context->set_context(); |
| 391 |
or |
398 |
or |
| 392 |
set_context C4::Context $context; |
399 |
set_context C4::Context $context; |
|
Lines 419-435
sub set_context
Link Here
|
| 419 |
if (ref($self) eq "") |
426 |
if (ref($self) eq "") |
| 420 |
{ |
427 |
{ |
| 421 |
# Class method. The new context is the next argument. |
428 |
# Class method. The new context is the next argument. |
| 422 |
$new_context = shift; |
429 |
$new_context = shift or croak "No new context"; |
| 423 |
} else { |
430 |
} else { |
| 424 |
# Instance method. The new context is $self. |
431 |
# Instance method. The new context is $self. |
| 425 |
$new_context = $self; |
432 |
$new_context = $self; |
| 426 |
} |
433 |
} |
| 427 |
|
434 |
|
| 428 |
# Save the old context, if any, on the stack |
435 |
# undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping |
| 429 |
push @context_stack, $context if defined($context); |
436 |
my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context); |
|
|
437 |
|
| 438 |
# Save the old context on the stack |
| 439 |
push @context_stack, $context; |
| 430 |
|
440 |
|
| 431 |
# Set the new context |
441 |
# Set the new context |
| 432 |
$context = $new_context; |
442 |
$context = $new_context; |
|
|
443 |
Koha::Database->set_schema($schema); |
| 433 |
} |
444 |
} |
| 434 |
|
445 |
|
| 435 |
=head2 restore_context |
446 |
=head2 restore_context |
|
Lines 445-463
sub restore_context
Link Here
|
| 445 |
{ |
456 |
{ |
| 446 |
my $self = shift; |
457 |
my $self = shift; |
| 447 |
|
458 |
|
| 448 |
if ($#context_stack < 0) |
|
|
| 449 |
{ |
| 450 |
# Stack underflow. |
| 451 |
die "Context stack underflow"; |
| 452 |
} |
| 453 |
|
| 454 |
# Pop the old context and set it. |
459 |
# Pop the old context and set it. |
| 455 |
$context = pop @context_stack; |
460 |
$context = pop @context_stack; |
|
|
461 |
Koha::Database->restore_schema(); |
| 456 |
|
462 |
|
| 457 |
# FIXME - Should this return something, like maybe the context |
463 |
# FIXME - Should this return something, like maybe the context |
| 458 |
# that was current when this was called? |
464 |
# that was current when this was called? |
| 459 |
} |
465 |
} |
| 460 |
|
466 |
|
|
|
467 |
=head2 run_within_context |
| 468 |
|
| 469 |
$context->run_within_context(sub {...}); |
| 470 |
|
| 471 |
Runs code within context |
| 472 |
|
| 473 |
=cut |
| 474 |
|
| 475 |
#' |
| 476 |
sub run_within_context |
| 477 |
{ |
| 478 |
my $self = shift; |
| 479 |
my $code = shift or croak "No code"; |
| 480 |
|
| 481 |
$self->set_context; |
| 482 |
|
| 483 |
local $@; |
| 484 |
my $ret = eval { $code->(@_) }; |
| 485 |
my $died = $@; |
| 486 |
$self->restore_context; |
| 487 |
die $died if $died; |
| 488 |
return $ret; |
| 489 |
} |
| 490 |
|
| 461 |
=head2 config |
491 |
=head2 config |
| 462 |
|
492 |
|
| 463 |
$value = C4::Context->config("config_variable"); |
493 |
$value = C4::Context->config("config_variable"); |
|
Lines 474-499
C<C4::Config-E<gt>new> will not return it.
Link Here
|
| 474 |
=cut |
504 |
=cut |
| 475 |
|
505 |
|
| 476 |
sub _common_config { |
506 |
sub _common_config { |
| 477 |
my $var = shift; |
507 |
my $self = shift; |
| 478 |
my $term = shift; |
508 |
my $var = shift; |
| 479 |
return if !defined($context->{$term}); |
509 |
my $term = shift; |
|
|
510 |
|
| 511 |
$self = $context unless ref $self; |
| 512 |
return if !defined($self->{$term}); |
| 480 |
# Presumably $self->{$term} might be |
513 |
# Presumably $self->{$term} might be |
| 481 |
# undefined if the config file given to &new |
514 |
# undefined if the config file given to &new |
| 482 |
# didn't exist, and the caller didn't bother |
515 |
# didn't exist, and the caller didn't bother |
| 483 |
# to check the return value. |
516 |
# to check the return value. |
| 484 |
|
517 |
|
| 485 |
# Return the value of the requested config variable |
518 |
# Return the value of the requested config variable |
| 486 |
return $context->{$term}->{$var}; |
519 |
return $self->{$term}->{$var}; |
| 487 |
} |
520 |
} |
| 488 |
|
521 |
|
| 489 |
sub config { |
522 |
sub config { |
| 490 |
return _common_config($_[1],'config'); |
523 |
my $self = shift; |
|
|
524 |
return $self->_common_config($_[0],'config'); |
| 491 |
} |
525 |
} |
| 492 |
sub zebraconfig { |
526 |
sub zebraconfig { |
| 493 |
return _common_config($_[1],'server'); |
527 |
my $self = shift; |
|
|
528 |
return $self->_common_config($_[0],'server'); |
| 494 |
} |
529 |
} |
| 495 |
sub ModZebrations { |
530 |
sub ModZebrations { |
| 496 |
return _common_config($_[1],'serverinfo'); |
531 |
my $self = shift; |
|
|
532 |
return $self->_common_config($_[0],'serverinfo'); |
| 497 |
} |
533 |
} |
| 498 |
|
534 |
|
| 499 |
=head2 preference |
535 |
=head2 preference |
|
Lines 512-521
with this method.
Link Here
|
| 512 |
|
548 |
|
| 513 |
=cut |
549 |
=cut |
| 514 |
|
550 |
|
| 515 |
my $syspref_cache = Koha::Cache->get_instance(); |
|
|
| 516 |
my $use_syspref_cache = 1; |
| 517 |
sub preference { |
551 |
sub preference { |
| 518 |
my $self = shift; |
552 |
my $self = shift; |
|
|
553 |
$self = $context unless ref $self; |
| 519 |
my $var = shift; # The system preference to return |
554 |
my $var = shift; # The system preference to return |
| 520 |
|
555 |
|
| 521 |
$var = lc $var; |
556 |
$var = lc $var; |
|
Lines 523-530
sub preference {
Link Here
|
| 523 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
558 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
| 524 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
559 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
| 525 |
|
560 |
|
| 526 |
my $cached_var = $use_syspref_cache |
561 |
my $cached_var = $self->{use_syspref_cache} |
| 527 |
? $syspref_cache->get_from_cache("syspref_$var") |
562 |
? $self->{syspref_cache}->get_from_cache("syspref_$var") |
| 528 |
: undef; |
563 |
: undef; |
| 529 |
return $cached_var if defined $cached_var; |
564 |
return $cached_var if defined $cached_var; |
| 530 |
|
565 |
|
|
Lines 532-539
sub preference {
Link Here
|
| 532 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
567 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
| 533 |
my $value = $syspref ? $syspref->value() : undef; |
568 |
my $value = $syspref ? $syspref->value() : undef; |
| 534 |
|
569 |
|
| 535 |
if ( $use_syspref_cache ) { |
570 |
if ( $self->{use_syspref_cache} ) { |
| 536 |
$syspref_cache->set_in_cache("syspref_$var", $value); |
571 |
$self->{syspref_cache}->set_in_cache("syspref_$var", $value); |
| 537 |
} |
572 |
} |
| 538 |
return $value; |
573 |
return $value; |
| 539 |
} |
574 |
} |
|
Lines 556-562
default behavior.
Link Here
|
| 556 |
|
591 |
|
| 557 |
sub enable_syspref_cache { |
592 |
sub enable_syspref_cache { |
| 558 |
my ($self) = @_; |
593 |
my ($self) = @_; |
| 559 |
$use_syspref_cache = 1; |
594 |
$self = $context unless ref $self; |
|
|
595 |
$self->{use_syspref_cache} = 1; |
| 560 |
# We need to clear the cache to have it up-to-date |
596 |
# We need to clear the cache to have it up-to-date |
| 561 |
$self->clear_syspref_cache(); |
597 |
$self->clear_syspref_cache(); |
| 562 |
} |
598 |
} |
|
Lines 572-578
used with Plack and other persistent environments.
Link Here
|
| 572 |
|
608 |
|
| 573 |
sub disable_syspref_cache { |
609 |
sub disable_syspref_cache { |
| 574 |
my ($self) = @_; |
610 |
my ($self) = @_; |
| 575 |
$use_syspref_cache = 0; |
611 |
$self = $context unless ref $self; |
|
|
612 |
$self->{use_syspref_cache} = 0; |
| 576 |
$self->clear_syspref_cache(); |
613 |
$self->clear_syspref_cache(); |
| 577 |
} |
614 |
} |
| 578 |
|
615 |
|
|
Lines 587-594
will not be seen by this process.
Link Here
|
| 587 |
=cut |
624 |
=cut |
| 588 |
|
625 |
|
| 589 |
sub clear_syspref_cache { |
626 |
sub clear_syspref_cache { |
| 590 |
return unless $use_syspref_cache; |
627 |
my ($self) = @_; |
| 591 |
$syspref_cache->flush_all; |
628 |
$self = $context unless ref $self; |
|
|
629 |
return unless $self->{use_syspref_cache}; |
| 630 |
$self->{syspref_cache}->flush_all; |
| 592 |
} |
631 |
} |
| 593 |
|
632 |
|
| 594 |
=head2 set_preference |
633 |
=head2 set_preference |
|
Lines 604-609
preference.
Link Here
|
| 604 |
|
643 |
|
| 605 |
sub set_preference { |
644 |
sub set_preference { |
| 606 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
645 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
|
|
646 |
$self = $context unless ref $self; |
| 607 |
|
647 |
|
| 608 |
$variable = lc $variable; |
648 |
$variable = lc $variable; |
| 609 |
|
649 |
|
|
Lines 639-646
sub set_preference {
Link Here
|
| 639 |
)->store(); |
679 |
)->store(); |
| 640 |
} |
680 |
} |
| 641 |
|
681 |
|
| 642 |
if ( $use_syspref_cache ) { |
682 |
if ( $self->{use_syspref_cache} ) { |
| 643 |
$syspref_cache->set_in_cache( "syspref_$variable", $value ); |
683 |
$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); |
| 644 |
} |
684 |
} |
| 645 |
|
685 |
|
| 646 |
return $syspref; |
686 |
return $syspref; |
|
Lines 658-667
was no syspref of the name.
Link Here
|
| 658 |
|
698 |
|
| 659 |
sub delete_preference { |
699 |
sub delete_preference { |
| 660 |
my ( $self, $var ) = @_; |
700 |
my ( $self, $var ) = @_; |
|
|
701 |
$self = $context unless ref $self; |
| 661 |
|
702 |
|
| 662 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
703 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
| 663 |
if ( $use_syspref_cache ) { |
704 |
if ( $self->{use_syspref_cache} ) { |
| 664 |
$syspref_cache->clear_from_cache("syspref_$var"); |
705 |
$self->{syspref_cache}->clear_from_cache("syspref_$var"); |
| 665 |
} |
706 |
} |
| 666 |
|
707 |
|
| 667 |
return 1; |
708 |
return 1; |
|
Lines 675-681
sub delete_preference {
Link Here
|
| 675 |
|
716 |
|
| 676 |
Returns a connection to the Zebra database |
717 |
Returns a connection to the Zebra database |
| 677 |
|
718 |
|
| 678 |
C<$self> |
719 |
C<$self> |
| 679 |
|
720 |
|
| 680 |
C<$server> one of the servers defined in the koha-conf.xml file |
721 |
C<$server> one of the servers defined in the koha-conf.xml file |
| 681 |
|
722 |
|
|
Lines 786-793
creates one, and connects to the database.
Link Here
|
| 786 |
|
827 |
|
| 787 |
This database handle is cached for future use: if you call |
828 |
This database handle is cached for future use: if you call |
| 788 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
829 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
| 789 |
times. If you need a second database handle, use C<&new_dbh> and |
830 |
times. If you need a second database handle, use C<&new_dbh>. |
| 790 |
possibly C<&set_dbh>. |
|
|
| 791 |
|
831 |
|
| 792 |
=cut |
832 |
=cut |
| 793 |
|
833 |
|
|
Lines 826-889
sub new_dbh
Link Here
|
| 826 |
return &dbh({ new => 1 }); |
866 |
return &dbh({ new => 1 }); |
| 827 |
} |
867 |
} |
| 828 |
|
868 |
|
| 829 |
=head2 set_dbh |
|
|
| 830 |
|
| 831 |
$my_dbh = C4::Connect->new_dbh; |
| 832 |
C4::Connect->set_dbh($my_dbh); |
| 833 |
... |
| 834 |
C4::Connect->restore_dbh; |
| 835 |
|
| 836 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
| 837 |
C<&set_context> and C<&restore_context>. |
| 838 |
|
| 839 |
C<&set_dbh> saves the current database handle on a stack, then sets |
| 840 |
the current database handle to C<$my_dbh>. |
| 841 |
|
| 842 |
C<$my_dbh> is assumed to be a good database handle. |
| 843 |
|
| 844 |
=cut |
| 845 |
|
| 846 |
#' |
| 847 |
sub set_dbh |
| 848 |
{ |
| 849 |
my $self = shift; |
| 850 |
my $new_dbh = shift; |
| 851 |
|
| 852 |
# Save the current database handle on the handle stack. |
| 853 |
# We assume that $new_dbh is all good: if the caller wants to |
| 854 |
# screw himself by passing an invalid handle, that's fine by |
| 855 |
# us. |
| 856 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
| 857 |
$context->{"dbh"} = $new_dbh; |
| 858 |
} |
| 859 |
|
| 860 |
=head2 restore_dbh |
| 861 |
|
| 862 |
C4::Context->restore_dbh; |
| 863 |
|
| 864 |
Restores the database handle saved by an earlier call to |
| 865 |
C<C4::Context-E<gt>set_dbh>. |
| 866 |
|
| 867 |
=cut |
| 868 |
|
| 869 |
#' |
| 870 |
sub restore_dbh |
| 871 |
{ |
| 872 |
my $self = shift; |
| 873 |
|
| 874 |
if ($#{$context->{"dbh_stack"}} < 0) |
| 875 |
{ |
| 876 |
# Stack underflow |
| 877 |
die "DBH stack underflow"; |
| 878 |
} |
| 879 |
|
| 880 |
# Pop the old database handle and set it. |
| 881 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
| 882 |
|
| 883 |
# FIXME - If it is determined that restore_context should |
| 884 |
# return something, then this function should, too. |
| 885 |
} |
| 886 |
|
| 887 |
=head2 queryparser |
869 |
=head2 queryparser |
| 888 |
|
870 |
|
| 889 |
$queryparser = C4::Context->queryparser |
871 |
$queryparser = C4::Context->queryparser |