|
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 103-108
use XML::Simple;
Link Here
|
| 103 |
use POSIX (); |
103 |
use POSIX (); |
| 104 |
use DateTime::TimeZone; |
104 |
use DateTime::TimeZone; |
| 105 |
use Module::Load::Conditional qw(can_load); |
105 |
use Module::Load::Conditional qw(can_load); |
|
|
106 |
use Data::Dumper; |
| 106 |
use Carp; |
107 |
use Carp; |
| 107 |
|
108 |
|
| 108 |
use C4::Boolean; |
109 |
use C4::Boolean; |
|
Lines 169-178
environment variable to the pathname of a configuration file to use.
Link Here
|
| 169 |
# file (/etc/koha/koha-conf.xml). |
170 |
# file (/etc/koha/koha-conf.xml). |
| 170 |
# dbh |
171 |
# dbh |
| 171 |
# A handle to the appropriate database for this context. |
172 |
# A handle to the appropriate database for this context. |
| 172 |
# dbh_stack |
|
|
| 173 |
# Used by &set_dbh and &restore_dbh to hold other database |
| 174 |
# handles for this context. |
| 175 |
# Zconn |
| 176 |
# A connection object for the Zebra server |
173 |
# A connection object for the Zebra server |
| 177 |
|
174 |
|
| 178 |
# Koha's main configuration file koha-conf.xml |
175 |
# Koha's main configuration file koha-conf.xml |
|
Lines 181-187
environment variable to the pathname of a configuration file to use.
Link Here
|
| 181 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
178 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
| 182 |
# 2. Path supplied in KOHA_CONF environment variable. |
179 |
# 2. Path supplied in KOHA_CONF environment variable. |
| 183 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
180 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
| 184 |
# as value has changed from its default of |
181 |
# as value has changed from its default of |
| 185 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
182 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
| 186 |
# when Koha is installed in 'standard' or 'single' |
183 |
# when Koha is installed in 'standard' or 'single' |
| 187 |
# mode. |
184 |
# mode. |
|
Lines 191-242
environment variable to the pathname of a configuration file to use.
Link Here
|
| 191 |
|
188 |
|
| 192 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
189 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
| 193 |
# Default config file, if none is specified |
190 |
# Default config file, if none is specified |
| 194 |
|
191 |
|
| 195 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
192 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
| 196 |
# path to config file set by installer |
193 |
# path to config file set by installer |
| 197 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
194 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
| 198 |
# when Koha is installed in 'standard' or 'single' |
195 |
# when Koha is installed in 'standard' or 'single' |
| 199 |
# mode. If Koha was installed in 'dev' mode, |
196 |
# mode. If Koha was installed in 'dev' mode, |
| 200 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
197 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
| 201 |
# developers should set the KOHA_CONF environment variable |
198 |
# developers should set the KOHA_CONF environment variable |
| 202 |
|
|
|
| 203 |
$context = undef; # Initially, no context is set |
| 204 |
@context_stack = (); # Initially, no saved contexts |
| 205 |
|
| 206 |
|
| 207 |
=head2 read_config_file |
| 208 |
|
| 209 |
Reads the specified Koha config file. |
| 210 |
|
| 211 |
Returns an object containing the configuration variables. The object's |
| 212 |
structure is a bit complex to the uninitiated ... take a look at the |
| 213 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
| 214 |
here are a few examples that may give you what you need: |
| 215 |
|
199 |
|
| 216 |
The simple elements nested within the <config> element: |
200 |
@context_stack = (); # Initially, no saved contexts |
| 217 |
|
201 |
|
| 218 |
my $pass = $koha->{'config'}->{'pass'}; |
202 |
=head2 current |
| 219 |
|
203 |
|
| 220 |
The <listen> elements: |
204 |
Returns the current context |
| 221 |
|
|
|
| 222 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
| 223 |
|
| 224 |
The elements nested within the <server> element: |
| 225 |
|
| 226 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
| 227 |
|
| 228 |
Returns undef in case of error. |
| 229 |
|
205 |
|
| 230 |
=cut |
206 |
=cut |
| 231 |
|
207 |
|
| 232 |
sub read_config_file { # Pass argument naming config file to read |
208 |
sub current { |
| 233 |
my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); |
209 |
return $context; |
| 234 |
|
|
|
| 235 |
if ($ismemcached) { |
| 236 |
$memcached->set('kohaconf',$koha); |
| 237 |
} |
| 238 |
|
| 239 |
return $koha; # Return value: ref-to-hash holding the configuration |
| 240 |
} |
210 |
} |
| 241 |
|
211 |
|
| 242 |
=head2 ismemcached |
212 |
=head2 ismemcached |
|
Lines 264-269
sub memcached {
Link Here
|
| 264 |
} |
234 |
} |
| 265 |
} |
235 |
} |
| 266 |
|
236 |
|
|
|
237 |
sub db_driver { |
| 238 |
my $self = shift; |
| 239 |
|
| 240 |
$self = $context unless ref ($self); |
| 241 |
return unless $self; |
| 242 |
|
| 243 |
return $self->{db_driver}; |
| 244 |
} |
| 245 |
|
| 267 |
=head2 db_scheme2dbi |
246 |
=head2 db_scheme2dbi |
| 268 |
|
247 |
|
| 269 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
248 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
|
Lines 284-303
sub import {
Link Here
|
| 284 |
# Create the default context ($C4::Context::Context) |
263 |
# Create the default context ($C4::Context::Context) |
| 285 |
# the first time the module is called |
264 |
# the first time the module is called |
| 286 |
# (a config file can be optionaly passed) |
265 |
# (a config file can be optionaly passed) |
|
|
266 |
# If ":no_config" is passed, no config load will be attempted |
| 267 |
# It saves the context values in the declared memcached server(s) |
| 268 |
# if currently available and uses those values until them expire and |
| 269 |
# re-reads them. |
| 270 |
|
| 271 |
my ($pkg,$config_file) = @_ ; |
| 287 |
|
272 |
|
| 288 |
# default context already exists? |
273 |
# default context already exists? |
| 289 |
return if $context; |
274 |
return if $context; |
| 290 |
|
275 |
|
|
|
276 |
if ($ismemcached) { |
| 277 |
# retrieve from memcached |
| 278 |
if (my $self = $memcached->get('kohaconf')) { |
| 279 |
$context = $self; |
| 280 |
return; |
| 281 |
} |
| 282 |
} |
| 283 |
|
| 284 |
# check that the specified config file exists and is not empty |
| 285 |
undef $config_file if defined $config_file && |
| 286 |
!( ref($config_file) || openhandle($config_file) || -s $config_file ); |
| 287 |
# Figure out a good config file to load if none was specified. |
| 288 |
if (!defined($config_file)) |
| 289 |
{ |
| 290 |
# If the $KOHA_CONF environment variable is set, use |
| 291 |
# that. Otherwise, use the built-in default. |
| 292 |
if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s $ENV{"KOHA_CONF"}) { |
| 293 |
$config_file = $ENV{"KOHA_CONF"}; |
| 294 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
| 295 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
| 296 |
# regex to anything else -- don't want installer to rewrite it |
| 297 |
$config_file = $INSTALLED_CONFIG_FNAME; |
| 298 |
} elsif (-s CONFIG_FNAME) { |
| 299 |
$config_file = CONFIG_FNAME; |
| 300 |
} else { |
| 301 |
die "unable to locate Koha configuration file koha-conf.xml"; |
| 302 |
} |
| 303 |
} |
| 304 |
|
| 291 |
# no ? so load it! |
305 |
# no ? so load it! |
| 292 |
my ($pkg,$config_file) = @_ ; |
306 |
return if $config_file && $config_file eq ":no_config"; |
| 293 |
my $new_ctx = __PACKAGE__->new($config_file); |
307 |
my $new_ctx = __PACKAGE__->new($config_file); |
| 294 |
return unless $new_ctx; |
308 |
return unless $new_ctx; |
| 295 |
|
309 |
|
| 296 |
# if successfully loaded, use it by default |
310 |
# if successfully loaded, use it by default |
| 297 |
$new_ctx->set_context; |
311 |
$context = $new_ctx; |
| 298 |
1; |
312 |
|
|
|
313 |
if ($ismemcached) { |
| 314 |
$memcached->set('kohaconf',$new_ctx); |
| 315 |
} |
| 299 |
} |
316 |
} |
| 300 |
|
317 |
|
|
|
318 |
use Scalar::Util qw(openhandle); |
| 301 |
=head2 new |
319 |
=head2 new |
| 302 |
|
320 |
|
| 303 |
$context = new C4::Context; |
321 |
$context = new C4::Context; |
|
Lines 307-315
Allocates a new context. Initializes the context from the specified
Link Here
|
| 307 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
325 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
| 308 |
environment variable, or F</etc/koha/koha-conf.xml>. |
326 |
environment variable, or F</etc/koha/koha-conf.xml>. |
| 309 |
|
327 |
|
| 310 |
It saves the koha-conf.xml values in the declared memcached server(s) |
328 |
XML structure is a bit complex to the uninitiated ... take a look at the |
| 311 |
if currently available and uses those values until them expire and |
329 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
| 312 |
re-reads them. |
330 |
here are a few examples that may give you what you need: |
|
|
331 |
|
| 332 |
The simple elements nested within the <config> element: |
| 333 |
|
| 334 |
my $pass = $koha->{'config'}->{'pass'}; |
| 335 |
|
| 336 |
The <listen> elements: |
| 337 |
|
| 338 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
| 339 |
|
| 340 |
The elements nested within the <server> element: |
| 341 |
|
| 342 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
| 343 |
|
| 344 |
Returns undef in case of error. |
| 313 |
|
345 |
|
| 314 |
C<&new> does not set this context as the new default context; for |
346 |
C<&new> does not set this context as the new default context; for |
| 315 |
that, use C<&set_context>. |
347 |
that, use C<&set_context>. |
|
Lines 321-366
that, use C<&set_context>.
Link Here
|
| 321 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
353 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
| 322 |
sub new { |
354 |
sub new { |
| 323 |
my $class = shift; |
355 |
my $class = shift; |
| 324 |
my $conf_fname = shift; # Config file to load |
356 |
my $conf_fname = shift or croak "No conf"; |
| 325 |
my $self = {}; |
357 |
my $namespace = shift; |
| 326 |
|
358 |
|
| 327 |
# check that the specified config file exists and is not empty |
359 |
my $self = XMLin( |
| 328 |
undef $conf_fname unless |
360 |
$conf_fname, |
| 329 |
(defined $conf_fname && -s $conf_fname); |
361 |
keyattr => ['id'], |
| 330 |
# Figure out a good config file to load if none was specified. |
362 |
forcearray => ['listen', 'server', 'serverinfo'], |
| 331 |
if (!defined($conf_fname)) |
363 |
suppressempty => '', |
| 332 |
{ |
364 |
); |
| 333 |
# If the $KOHA_CONF environment variable is set, use |
365 |
die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) |
| 334 |
# that. Otherwise, use the built-in default. |
366 |
unless ref($self) && $self->{"config"}; |
| 335 |
if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) { |
|
|
| 336 |
$conf_fname = $ENV{"KOHA_CONF"}; |
| 337 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
| 338 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
| 339 |
# regex to anything else -- don't want installer to rewrite it |
| 340 |
$conf_fname = $INSTALLED_CONFIG_FNAME; |
| 341 |
} elsif (-s CONFIG_FNAME) { |
| 342 |
$conf_fname = CONFIG_FNAME; |
| 343 |
} else { |
| 344 |
warn "unable to locate Koha configuration file koha-conf.xml"; |
| 345 |
return; |
| 346 |
} |
| 347 |
} |
| 348 |
|
| 349 |
if ($ismemcached) { |
| 350 |
# retrieve from memcached |
| 351 |
$self = $memcached->get('kohaconf'); |
| 352 |
if (not defined $self) { |
| 353 |
# not in memcached yet |
| 354 |
$self = read_config_file($conf_fname); |
| 355 |
} |
| 356 |
} else { |
| 357 |
# non-memcached env, read from file |
| 358 |
$self = read_config_file($conf_fname); |
| 359 |
} |
| 360 |
|
367 |
|
| 361 |
$self->{"config_file"} = $conf_fname; |
368 |
$self->{"config_file"} = $conf_fname; |
| 362 |
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |
369 |
$self->{"namespace"} = $namespace; |
| 363 |
return if !defined($self->{"config"}); |
|
|
| 364 |
|
370 |
|
| 365 |
$self->{"Zconn"} = undef; # Zebra Connections |
371 |
$self->{"Zconn"} = undef; # Zebra Connections |
| 366 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
372 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
|
Lines 407-419
sub set_context
Link Here
|
| 407 |
# break this assumption by playing silly buggers, but that's |
413 |
# break this assumption by playing silly buggers, but that's |
| 408 |
# harder to do than doing it properly, and harder to check |
414 |
# harder to do than doing it properly, and harder to check |
| 409 |
# for. |
415 |
# for. |
|
|
416 |
my $schema; |
| 410 |
if (ref($self) eq "") |
417 |
if (ref($self) eq "") |
| 411 |
{ |
418 |
{ |
| 412 |
# Class method. The new context is the next argument. |
419 |
# Class method. The new context is the next argument. |
| 413 |
$new_context = shift; |
420 |
$new_context = shift or croak "No new context"; |
|
|
421 |
$schema = Koha::Database->new_schema($new_context); |
| 414 |
} else { |
422 |
} else { |
| 415 |
# Instance method. The new context is $self. |
423 |
# Instance method. The new context is $self. |
| 416 |
$new_context = $self; |
424 |
$new_context = $self; |
|
|
425 |
|
| 426 |
# undef $self->{schema} if $self->{schema} && !$self->{schema}->ping |
| 427 |
$schema = $self->{schema} ||= Koha::Database->new_schema($self); |
| 417 |
} |
428 |
} |
| 418 |
|
429 |
|
| 419 |
# Save the old context, if any, on the stack |
430 |
# Save the old context, if any, on the stack |
|
Lines 421-426
sub set_context
Link Here
|
| 421 |
|
432 |
|
| 422 |
# Set the new context |
433 |
# Set the new context |
| 423 |
$context = $new_context; |
434 |
$context = $new_context; |
|
|
435 |
Koha::Database->set_schema($schema); |
| 424 |
} |
436 |
} |
| 425 |
|
437 |
|
| 426 |
=head2 restore_context |
438 |
=head2 restore_context |
|
Lines 436-454
sub restore_context
Link Here
|
| 436 |
{ |
448 |
{ |
| 437 |
my $self = shift; |
449 |
my $self = shift; |
| 438 |
|
450 |
|
| 439 |
if ($#context_stack < 0) |
|
|
| 440 |
{ |
| 441 |
# Stack underflow. |
| 442 |
die "Context stack underflow"; |
| 443 |
} |
| 444 |
|
| 445 |
# Pop the old context and set it. |
451 |
# Pop the old context and set it. |
| 446 |
$context = pop @context_stack; |
452 |
$context = pop @context_stack; |
|
|
453 |
Koha::Database->restore_schema(); |
| 447 |
|
454 |
|
| 448 |
# FIXME - Should this return something, like maybe the context |
455 |
# FIXME - Should this return something, like maybe the context |
| 449 |
# that was current when this was called? |
456 |
# that was current when this was called? |
| 450 |
} |
457 |
} |
| 451 |
|
458 |
|
|
|
459 |
=head2 run_within_context |
| 460 |
|
| 461 |
$context->run_within_context(sub {...}); |
| 462 |
|
| 463 |
Runs code within context |
| 464 |
|
| 465 |
=cut |
| 466 |
|
| 467 |
#' |
| 468 |
sub run_within_context |
| 469 |
{ |
| 470 |
my $self = shift; |
| 471 |
my $code = shift or croak "No code"; |
| 472 |
|
| 473 |
$self->set_context; |
| 474 |
|
| 475 |
local $@; |
| 476 |
my $ret = eval { $code->(@_) }; |
| 477 |
my $died = $@; |
| 478 |
$self->restore_context; |
| 479 |
die $died if $died; |
| 480 |
return $ret; |
| 481 |
} |
| 482 |
|
| 452 |
=head2 config |
483 |
=head2 config |
| 453 |
|
484 |
|
| 454 |
$value = C4::Context->config("config_variable"); |
485 |
$value = C4::Context->config("config_variable"); |
|
Lines 465-490
C<C4::Config-E<gt>new> will not return it.
Link Here
|
| 465 |
=cut |
496 |
=cut |
| 466 |
|
497 |
|
| 467 |
sub _common_config { |
498 |
sub _common_config { |
| 468 |
my $var = shift; |
499 |
my $self = shift; |
| 469 |
my $term = shift; |
500 |
my $var = shift; |
| 470 |
return if !defined($context->{$term}); |
501 |
my $term = shift; |
|
|
502 |
|
| 503 |
$self = $context unless ref $self; |
| 504 |
return if !defined($self->{$term}); |
| 471 |
# Presumably $self->{$term} might be |
505 |
# Presumably $self->{$term} might be |
| 472 |
# undefined if the config file given to &new |
506 |
# undefined if the config file given to &new |
| 473 |
# didn't exist, and the caller didn't bother |
507 |
# didn't exist, and the caller didn't bother |
| 474 |
# to check the return value. |
508 |
# to check the return value. |
| 475 |
|
509 |
|
| 476 |
# Return the value of the requested config variable |
510 |
# Return the value of the requested config variable |
| 477 |
return $context->{$term}->{$var}; |
511 |
return $self->{$term}->{$var}; |
| 478 |
} |
512 |
} |
| 479 |
|
513 |
|
| 480 |
sub config { |
514 |
sub config { |
| 481 |
return _common_config($_[1],'config'); |
515 |
my $self = shift; |
|
|
516 |
return $self->_common_config($_[0],'config'); |
| 482 |
} |
517 |
} |
| 483 |
sub zebraconfig { |
518 |
sub zebraconfig { |
| 484 |
return _common_config($_[1],'server'); |
519 |
my $self = shift; |
|
|
520 |
return $self->_common_config($_[0],'server'); |
| 485 |
} |
521 |
} |
| 486 |
sub ModZebrations { |
522 |
sub ModZebrations { |
| 487 |
return _common_config($_[1],'serverinfo'); |
523 |
my $self = shift; |
|
|
524 |
return $self->_common_config($_[0],'serverinfo'); |
| 488 |
} |
525 |
} |
| 489 |
|
526 |
|
| 490 |
=head2 preference |
527 |
=head2 preference |
|
Lines 517-524
sub preference {
Link Here
|
| 517 |
|
554 |
|
| 518 |
return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var}; |
555 |
return $self->{sysprefs}{$lc_var} if $use_syspref_cache && $self && exists $self->{sysprefs}{$lc_var}; |
| 519 |
|
556 |
|
| 520 |
my $dbh = C4::Context->dbh or return 0; |
|
|
| 521 |
|
| 522 |
my $value; |
557 |
my $value; |
| 523 |
if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { |
558 |
if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { |
| 524 |
$value = $ENV{"OVERRIDE_SYSPREF_$var"}; |
559 |
$value = $ENV{"OVERRIDE_SYSPREF_$var"}; |
|
Lines 626-632
sub set_preference {
Link Here
|
| 626 |
|
661 |
|
| 627 |
Returns a connection to the Zebra database |
662 |
Returns a connection to the Zebra database |
| 628 |
|
663 |
|
| 629 |
C<$self> |
664 |
C<$self> |
| 630 |
|
665 |
|
| 631 |
C<$server> one of the servers defined in the koha-conf.xml file |
666 |
C<$server> one of the servers defined in the koha-conf.xml file |
| 632 |
|
667 |
|
|
Lines 737-744
creates one, and connects to the database.
Link Here
|
| 737 |
|
772 |
|
| 738 |
This database handle is cached for future use: if you call |
773 |
This database handle is cached for future use: if you call |
| 739 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
774 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
| 740 |
times. If you need a second database handle, use C<&new_dbh> and |
775 |
times. If you need a second database handle, use C<&new_dbh>. |
| 741 |
possibly C<&set_dbh>. |
|
|
| 742 |
|
776 |
|
| 743 |
=cut |
777 |
=cut |
| 744 |
|
778 |
|
|
Lines 777-840
sub new_dbh
Link Here
|
| 777 |
return &dbh({ new => 1 }); |
811 |
return &dbh({ new => 1 }); |
| 778 |
} |
812 |
} |
| 779 |
|
813 |
|
| 780 |
=head2 set_dbh |
|
|
| 781 |
|
| 782 |
$my_dbh = C4::Connect->new_dbh; |
| 783 |
C4::Connect->set_dbh($my_dbh); |
| 784 |
... |
| 785 |
C4::Connect->restore_dbh; |
| 786 |
|
| 787 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
| 788 |
C<&set_context> and C<&restore_context>. |
| 789 |
|
| 790 |
C<&set_dbh> saves the current database handle on a stack, then sets |
| 791 |
the current database handle to C<$my_dbh>. |
| 792 |
|
| 793 |
C<$my_dbh> is assumed to be a good database handle. |
| 794 |
|
| 795 |
=cut |
| 796 |
|
| 797 |
#' |
| 798 |
sub set_dbh |
| 799 |
{ |
| 800 |
my $self = shift; |
| 801 |
my $new_dbh = shift; |
| 802 |
|
| 803 |
# Save the current database handle on the handle stack. |
| 804 |
# We assume that $new_dbh is all good: if the caller wants to |
| 805 |
# screw himself by passing an invalid handle, that's fine by |
| 806 |
# us. |
| 807 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
| 808 |
$context->{"dbh"} = $new_dbh; |
| 809 |
} |
| 810 |
|
| 811 |
=head2 restore_dbh |
| 812 |
|
| 813 |
C4::Context->restore_dbh; |
| 814 |
|
| 815 |
Restores the database handle saved by an earlier call to |
| 816 |
C<C4::Context-E<gt>set_dbh>. |
| 817 |
|
| 818 |
=cut |
| 819 |
|
| 820 |
#' |
| 821 |
sub restore_dbh |
| 822 |
{ |
| 823 |
my $self = shift; |
| 824 |
|
| 825 |
if ($#{$context->{"dbh_stack"}} < 0) |
| 826 |
{ |
| 827 |
# Stack underflow |
| 828 |
die "DBH stack underflow"; |
| 829 |
} |
| 830 |
|
| 831 |
# Pop the old database handle and set it. |
| 832 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
| 833 |
|
| 834 |
# FIXME - If it is determined that restore_context should |
| 835 |
# return something, then this function should, too. |
| 836 |
} |
| 837 |
|
| 838 |
=head2 queryparser |
814 |
=head2 queryparser |
| 839 |
|
815 |
|
| 840 |
$queryparser = C4::Context->queryparser |
816 |
$queryparser = C4::Context->queryparser |