|
Lines 32-38
BEGIN {
Link Here
|
| 32 |
eval {C4::Context->dbh();}; |
32 |
eval {C4::Context->dbh();}; |
| 33 |
if ($@){ |
33 |
if ($@){ |
| 34 |
$debug_level = 1; |
34 |
$debug_level = 1; |
| 35 |
} |
35 |
} |
| 36 |
else { |
36 |
else { |
| 37 |
$debug_level = C4::Context->preference("DebugLevel"); |
37 |
$debug_level = C4::Context->preference("DebugLevel"); |
| 38 |
} |
38 |
} |
|
Lines 50-56
BEGIN {
Link Here
|
| 50 |
# a little example table with various version info"; |
50 |
# a little example table with various version info"; |
| 51 |
print " |
51 |
print " |
| 52 |
<h1>Koha error</h1> |
52 |
<h1>Koha error</h1> |
| 53 |
<p>The following fatal error has occurred:</p> |
53 |
<p>The following fatal error has occurred:</p> |
| 54 |
<pre><code>$msg</code></pre> |
54 |
<pre><code>$msg</code></pre> |
| 55 |
<table> |
55 |
<table> |
| 56 |
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr> |
56 |
<tr><th>Apache</th><td> $versions{apacheVersion}</td></tr> |
|
Lines 64-74
BEGIN {
Link Here
|
| 64 |
} elsif ($debug_level eq "1"){ |
64 |
} elsif ($debug_level eq "1"){ |
| 65 |
print " |
65 |
print " |
| 66 |
<h1>Koha error</h1> |
66 |
<h1>Koha error</h1> |
| 67 |
<p>The following fatal error has occurred:</p> |
67 |
<p>The following fatal error has occurred:</p> |
| 68 |
<pre><code>$msg</code></pre>"; |
68 |
<pre><code>$msg</code></pre>"; |
| 69 |
} else { |
69 |
} else { |
| 70 |
print "<p>production mode - trapped fatal error</p>"; |
70 |
print "<p>production mode - trapped fatal error</p>"; |
| 71 |
} |
71 |
} |
| 72 |
print "</body></html>"; |
72 |
print "</body></html>"; |
| 73 |
} |
73 |
} |
| 74 |
#CGI::Carp::set_message(\&handle_errors); |
74 |
#CGI::Carp::set_message(\&handle_errors); |
|
Lines 96-101
use Koha::Caches;
Link Here
|
| 96 |
use POSIX (); |
96 |
use POSIX (); |
| 97 |
use DateTime::TimeZone; |
97 |
use DateTime::TimeZone; |
| 98 |
use Module::Load::Conditional qw(can_load); |
98 |
use Module::Load::Conditional qw(can_load); |
|
|
99 |
use Data::Dumper; |
| 99 |
use Carp; |
100 |
use Carp; |
| 100 |
use DateTime::TimeZone; |
101 |
use DateTime::TimeZone; |
| 101 |
|
102 |
|
|
Lines 165-178
environment variable to the pathname of a configuration file to use.
Link Here
|
| 165 |
# file (/etc/koha/koha-conf.xml). |
166 |
# file (/etc/koha/koha-conf.xml). |
| 166 |
# dbh |
167 |
# dbh |
| 167 |
# A handle to the appropriate database for this context. |
168 |
# A handle to the appropriate database for this context. |
| 168 |
# dbh_stack |
|
|
| 169 |
# Used by &set_dbh and &restore_dbh to hold other database |
| 170 |
# handles for this context. |
| 171 |
# Zconn |
| 172 |
# A connection object for the Zebra server |
169 |
# A connection object for the Zebra server |
| 173 |
|
170 |
|
| 174 |
$context = undef; # Initially, no context is set |
171 |
@context_stack = (); # Initially, no saved contexts |
| 175 |
@context_stack = (); # Initially, no saved contexts |
172 |
|
|
|
173 |
=head2 current |
| 174 |
|
| 175 |
Returns the current context |
| 176 |
|
| 177 |
=cut |
| 178 |
|
| 179 |
sub current { |
| 180 |
return $context; |
| 181 |
} |
| 182 |
|
| 183 |
=head2 cache |
| 184 |
|
| 185 |
Returns the cache object or undef |
| 186 |
|
| 187 |
=cut |
| 188 |
|
| 189 |
sub cache { |
| 190 |
my $self = shift; |
| 191 |
$self = $context unless ref ($self); |
| 192 |
|
| 193 |
return Koha::Caches->get_instance($self->{namespace}); |
| 194 |
} |
| 195 |
|
| 196 |
=head2 memcached |
| 197 |
|
| 198 |
Returns the cache object if it is memcached or undef |
| 199 |
|
| 200 |
=cut |
| 201 |
|
| 202 |
sub memcached { |
| 203 |
my $self = shift; |
| 204 |
my $cache = $self->cache; |
| 205 |
return $cache if $cache->memcached_cache; |
| 206 |
|
| 207 |
return; |
| 208 |
} |
| 209 |
|
| 210 |
sub db_driver { |
| 211 |
my $self = shift; |
| 212 |
|
| 213 |
$self = $context unless ref ($self); |
| 214 |
return unless $self; |
| 215 |
|
| 216 |
return $self->{db_driver}; |
| 217 |
} |
| 176 |
|
218 |
|
| 177 |
=head2 db_scheme2dbi |
219 |
=head2 db_scheme2dbi |
| 178 |
|
220 |
|
|
Lines 194-225
sub import {
Link Here
|
| 194 |
# Create the default context ($C4::Context::Context) |
236 |
# Create the default context ($C4::Context::Context) |
| 195 |
# the first time the module is called |
237 |
# the first time the module is called |
| 196 |
# (a config file can be optionaly passed) |
238 |
# (a config file can be optionaly passed) |
|
|
239 |
# If ":no_config" is passed, no config load will be attempted |
| 240 |
# It saves the context values in the declared memcached server(s) |
| 241 |
# if currently available and uses those values until them expire and |
| 242 |
# re-reads them. |
| 243 |
|
| 244 |
my ($pkg,$config_file) = @_; |
| 197 |
|
245 |
|
| 198 |
# default context already exists? |
246 |
# default context already exists? |
| 199 |
return if $context; |
247 |
return if $context; |
| 200 |
|
248 |
|
| 201 |
# no ? so load it! |
249 |
# multihost, we don't want/have one default config |
| 202 |
my ($pkg,$config_file) = @_ ; |
250 |
return if $config_file && $config_file eq ":no_config"; |
| 203 |
my $new_ctx = __PACKAGE__->new($config_file); |
|
|
| 204 |
return unless $new_ctx; |
| 205 |
|
251 |
|
| 206 |
# if successfully loaded, use it by default |
252 |
my $conf_cache = Koha::Caches->get_instance('config'); |
| 207 |
$new_ctx->set_context; |
253 |
if ( $conf_cache->cache ) { |
| 208 |
1; |
254 |
if ( $context = $conf_cache->get_from_cache('koha_conf') ) { |
|
|
255 |
return; |
| 256 |
} |
| 257 |
} |
| 258 |
|
| 259 |
undef $config_file if $config_file && !-s $config_file; |
| 260 |
$config_file ||= Koha::Config->guess_koha_conf(); |
| 261 |
$context = __PACKAGE__->new($config_file); |
| 262 |
return unless $context; |
| 263 |
|
| 264 |
if ( $conf_cache->memcached_cache ) { |
| 265 |
# FIXME it may be better to use the memcached servers from the config file |
| 266 |
# to cache it |
| 267 |
$conf_cache->set_in_cache('koha_conf', $context) |
| 268 |
} |
| 209 |
} |
269 |
} |
| 210 |
|
270 |
|
| 211 |
=head2 new |
271 |
=head2 new |
| 212 |
|
272 |
|
| 213 |
$context = new C4::Context; |
|
|
| 214 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
273 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
| 215 |
|
274 |
|
| 216 |
Allocates a new context. Initializes the context from the specified |
275 |
Allocates a new context. Initializes the context from the specified |
| 217 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
276 |
file. |
| 218 |
environment variable, or F</etc/koha/koha-conf.xml>. |
|
|
| 219 |
|
| 220 |
It saves the koha-conf.xml values in the declared memcached server(s) |
| 221 |
if currently available and uses those values until them expire and |
| 222 |
re-reads them. |
| 223 |
|
277 |
|
| 224 |
C<&new> does not set this context as the new default context; for |
278 |
C<&new> does not set this context as the new default context; for |
| 225 |
that, use C<&set_context>. |
279 |
that, use C<&set_context>. |
|
Lines 231-268
that, use C<&set_context>.
Link Here
|
| 231 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
285 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
| 232 |
sub new { |
286 |
sub new { |
| 233 |
my $class = shift; |
287 |
my $class = shift; |
| 234 |
my $conf_fname = shift; # Config file to load |
288 |
my $conf_fname = shift or croak "No conf"; |
| 235 |
my $self = {}; |
289 |
my $namespace = shift; |
| 236 |
|
|
|
| 237 |
# check that the specified config file exists and is not empty |
| 238 |
undef $conf_fname unless |
| 239 |
(defined $conf_fname && -s $conf_fname); |
| 240 |
# Figure out a good config file to load if none was specified. |
| 241 |
unless ( defined $conf_fname ) { |
| 242 |
$conf_fname = Koha::Config->guess_koha_conf; |
| 243 |
unless ( $conf_fname ) { |
| 244 |
warn "unable to locate Koha configuration file koha-conf.xml"; |
| 245 |
return; |
| 246 |
} |
| 247 |
} |
| 248 |
|
290 |
|
| 249 |
my $conf_cache = Koha::Caches->get_instance('config'); |
291 |
my $self = Koha::Config->read_from_file($conf_fname); |
| 250 |
my $config_from_cache; |
292 |
die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) |
| 251 |
if ( $conf_cache->cache ) { |
293 |
unless ref($self) && $self->{"config"}; |
| 252 |
$self = $conf_cache->get_from_cache('koha_conf'); |
294 |
|
| 253 |
} |
295 |
$self->{config_file} = $conf_fname; |
| 254 |
unless ( $self and %$self ) { |
296 |
$self->{namespace} = $namespace; |
| 255 |
$self = Koha::Config->read_from_file($conf_fname); |
297 |
$self->{use_syspref_cache} = 1; |
| 256 |
if ( $conf_cache->memcached_cache ) { |
298 |
$self->{syspref_cache} = Koha::Caches->get_instance('syspref', $namespace); |
| 257 |
# FIXME it may be better to use the memcached servers from the config file |
|
|
| 258 |
# to cache it |
| 259 |
$conf_cache->set_in_cache('koha_conf', $self) |
| 260 |
} |
| 261 |
} |
| 262 |
unless ( exists $self->{config} or defined $self->{config} ) { |
| 263 |
warn "The config file ($conf_fname) has not been parsed correctly"; |
| 264 |
return; |
| 265 |
} |
| 266 |
|
299 |
|
| 267 |
$self->{"Zconn"} = undef; # Zebra Connections |
300 |
$self->{"Zconn"} = undef; # Zebra Connections |
| 268 |
$self->{"userenv"} = undef; # User env |
301 |
$self->{"userenv"} = undef; # User env |
|
Lines 277-283
sub new {
Link Here
|
| 277 |
|
310 |
|
| 278 |
=head2 set_context |
311 |
=head2 set_context |
| 279 |
|
312 |
|
| 280 |
$context = new C4::Context; |
|
|
| 281 |
$context->set_context(); |
313 |
$context->set_context(); |
| 282 |
or |
314 |
or |
| 283 |
set_context C4::Context $context; |
315 |
set_context C4::Context $context; |
|
Lines 310-326
sub set_context
Link Here
|
| 310 |
if (ref($self) eq "") |
342 |
if (ref($self) eq "") |
| 311 |
{ |
343 |
{ |
| 312 |
# Class method. The new context is the next argument. |
344 |
# Class method. The new context is the next argument. |
| 313 |
$new_context = shift; |
345 |
$new_context = shift or croak "No new context"; |
| 314 |
} else { |
346 |
} else { |
| 315 |
# Instance method. The new context is $self. |
347 |
# Instance method. The new context is $self. |
| 316 |
$new_context = $self; |
348 |
$new_context = $self; |
| 317 |
} |
349 |
} |
| 318 |
|
350 |
|
| 319 |
# Save the old context, if any, on the stack |
351 |
# undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping |
| 320 |
push @context_stack, $context if defined($context); |
352 |
my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context); |
|
|
353 |
|
| 354 |
# Save the old context on the stack |
| 355 |
push @context_stack, $context; |
| 321 |
|
356 |
|
| 322 |
# Set the new context |
357 |
# Set the new context |
| 323 |
$context = $new_context; |
358 |
$context = $new_context; |
|
|
359 |
Koha::Database->set_schema($schema); |
| 324 |
} |
360 |
} |
| 325 |
|
361 |
|
| 326 |
=head2 restore_context |
362 |
=head2 restore_context |
|
Lines 336-354
sub restore_context
Link Here
|
| 336 |
{ |
372 |
{ |
| 337 |
my $self = shift; |
373 |
my $self = shift; |
| 338 |
|
374 |
|
| 339 |
if ($#context_stack < 0) |
|
|
| 340 |
{ |
| 341 |
# Stack underflow. |
| 342 |
die "Context stack underflow"; |
| 343 |
} |
| 344 |
|
| 345 |
# Pop the old context and set it. |
375 |
# Pop the old context and set it. |
| 346 |
$context = pop @context_stack; |
376 |
$context = pop @context_stack; |
|
|
377 |
Koha::Database->restore_schema(); |
| 347 |
|
378 |
|
| 348 |
# FIXME - Should this return something, like maybe the context |
379 |
# FIXME - Should this return something, like maybe the context |
| 349 |
# that was current when this was called? |
380 |
# that was current when this was called? |
| 350 |
} |
381 |
} |
| 351 |
|
382 |
|
|
|
383 |
=head2 run_within_context |
| 384 |
|
| 385 |
$context->run_within_context(sub {...}); |
| 386 |
|
| 387 |
Runs code within context |
| 388 |
|
| 389 |
=cut |
| 390 |
|
| 391 |
#' |
| 392 |
sub run_within_context |
| 393 |
{ |
| 394 |
my $self = shift; |
| 395 |
my $code = shift or croak "No code"; |
| 396 |
|
| 397 |
$self->set_context; |
| 398 |
|
| 399 |
local $@; |
| 400 |
my $ret = eval { $code->(@_) }; |
| 401 |
my $died = $@; |
| 402 |
$self->restore_context; |
| 403 |
die $died if $died; |
| 404 |
return $ret; |
| 405 |
} |
| 406 |
|
| 352 |
=head2 config |
407 |
=head2 config |
| 353 |
|
408 |
|
| 354 |
$value = C4::Context->config("config_variable"); |
409 |
$value = C4::Context->config("config_variable"); |
|
Lines 365-390
C<C4::Config-E<gt>new> will not return it.
Link Here
|
| 365 |
=cut |
420 |
=cut |
| 366 |
|
421 |
|
| 367 |
sub _common_config { |
422 |
sub _common_config { |
| 368 |
my $var = shift; |
423 |
my $self = shift; |
| 369 |
my $term = shift; |
424 |
my $var = shift; |
| 370 |
return if !defined($context->{$term}); |
425 |
my $term = shift; |
|
|
426 |
|
| 427 |
$self = $context unless ref $self; |
| 428 |
return if !defined($self->{$term}); |
| 371 |
# Presumably $self->{$term} might be |
429 |
# Presumably $self->{$term} might be |
| 372 |
# undefined if the config file given to &new |
430 |
# undefined if the config file given to &new |
| 373 |
# didn't exist, and the caller didn't bother |
431 |
# didn't exist, and the caller didn't bother |
| 374 |
# to check the return value. |
432 |
# to check the return value. |
| 375 |
|
433 |
|
| 376 |
# Return the value of the requested config variable |
434 |
# Return the value of the requested config variable |
| 377 |
return $context->{$term}->{$var}; |
435 |
return $self->{$term}->{$var}; |
| 378 |
} |
436 |
} |
| 379 |
|
437 |
|
| 380 |
sub config { |
438 |
sub config { |
| 381 |
return _common_config($_[1],'config'); |
439 |
my $self = shift; |
|
|
440 |
return $self->_common_config($_[0],'config'); |
| 382 |
} |
441 |
} |
| 383 |
sub zebraconfig { |
442 |
sub zebraconfig { |
| 384 |
return _common_config($_[1],'server'); |
443 |
my $self = shift; |
|
|
444 |
return $self->_common_config($_[0],'server'); |
| 385 |
} |
445 |
} |
| 386 |
sub ModZebrations { |
446 |
sub ModZebrations { |
| 387 |
return _common_config($_[1],'serverinfo'); |
447 |
my $self = shift; |
|
|
448 |
return $self->_common_config($_[0],'serverinfo'); |
| 388 |
} |
449 |
} |
| 389 |
|
450 |
|
| 390 |
=head2 preference |
451 |
=head2 preference |
|
Lines 403-431
with this method.
Link Here
|
| 403 |
|
464 |
|
| 404 |
=cut |
465 |
=cut |
| 405 |
|
466 |
|
| 406 |
my $syspref_cache = Koha::Caches->get_instance('syspref'); |
|
|
| 407 |
my $use_syspref_cache = 1; |
| 408 |
sub preference { |
467 |
sub preference { |
| 409 |
my $self = shift; |
468 |
my $self = shift; |
|
|
469 |
$self = $context unless ref $self; |
| 410 |
my $var = shift; # The system preference to return |
470 |
my $var = shift; # The system preference to return |
| 411 |
|
471 |
|
|
|
472 |
$var = lc $var; |
| 473 |
|
| 412 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
474 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
| 413 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
475 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
| 414 |
|
476 |
|
| 415 |
$var = lc $var; |
477 |
my $cached_var = $self->{use_syspref_cache} |
| 416 |
|
478 |
? $self->{syspref_cache}->get_from_cache("syspref_$var") |
| 417 |
if ($use_syspref_cache) { |
479 |
: undef; |
| 418 |
$syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache; |
480 |
return $cached_var if defined $cached_var; |
| 419 |
my $cached_var = $syspref_cache->get_from_cache("syspref_$var"); |
|
|
| 420 |
return $cached_var if defined $cached_var; |
| 421 |
} |
| 422 |
|
481 |
|
| 423 |
my $syspref; |
482 |
my $syspref; |
| 424 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
483 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
| 425 |
my $value = $syspref ? $syspref->value() : undef; |
484 |
my $value = $syspref ? $syspref->value() : undef; |
| 426 |
|
485 |
|
| 427 |
if ( $use_syspref_cache ) { |
486 |
if ( $self->{use_syspref_cache} ) { |
| 428 |
$syspref_cache->set_in_cache("syspref_$var", $value); |
487 |
$self->{syspref_cache}->set_in_cache("syspref_$var", $value); |
| 429 |
} |
488 |
} |
| 430 |
return $value; |
489 |
return $value; |
| 431 |
} |
490 |
} |
|
Lines 448-454
default behavior.
Link Here
|
| 448 |
|
507 |
|
| 449 |
sub enable_syspref_cache { |
508 |
sub enable_syspref_cache { |
| 450 |
my ($self) = @_; |
509 |
my ($self) = @_; |
| 451 |
$use_syspref_cache = 1; |
510 |
$self = $context unless ref $self; |
|
|
511 |
$self->{use_syspref_cache} = 1; |
| 452 |
# We need to clear the cache to have it up-to-date |
512 |
# We need to clear the cache to have it up-to-date |
| 453 |
$self->clear_syspref_cache(); |
513 |
$self->clear_syspref_cache(); |
| 454 |
} |
514 |
} |
|
Lines 464-471
used with Plack and other persistent environments.
Link Here
|
| 464 |
|
524 |
|
| 465 |
sub disable_syspref_cache { |
525 |
sub disable_syspref_cache { |
| 466 |
my ($self) = @_; |
526 |
my ($self) = @_; |
| 467 |
$use_syspref_cache = 0; |
527 |
$self = $context unless ref $self; |
| 468 |
$self->clear_syspref_cache(); |
528 |
$self->clear_syspref_cache(); |
|
|
529 |
$self->{use_syspref_cache} = 0; |
| 469 |
} |
530 |
} |
| 470 |
|
531 |
|
| 471 |
=head2 clear_syspref_cache |
532 |
=head2 clear_syspref_cache |
|
Lines 479-486
will not be seen by this process.
Link Here
|
| 479 |
=cut |
540 |
=cut |
| 480 |
|
541 |
|
| 481 |
sub clear_syspref_cache { |
542 |
sub clear_syspref_cache { |
| 482 |
return unless $use_syspref_cache; |
543 |
my ($self) = @_; |
| 483 |
$syspref_cache->flush_all; |
544 |
$self = $context unless ref $self; |
|
|
545 |
return unless $self->{use_syspref_cache}; |
| 546 |
$self->{syspref_cache}->flush_all; |
| 484 |
} |
547 |
} |
| 485 |
|
548 |
|
| 486 |
=head2 set_preference |
549 |
=head2 set_preference |
|
Lines 496-501
preference.
Link Here
|
| 496 |
|
559 |
|
| 497 |
sub set_preference { |
560 |
sub set_preference { |
| 498 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
561 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
|
|
562 |
$self = $context unless ref $self; |
| 499 |
|
563 |
|
| 500 |
my $variable_case = $variable; |
564 |
my $variable_case = $variable; |
| 501 |
$variable = lc $variable; |
565 |
$variable = lc $variable; |
|
Lines 532-539
sub set_preference {
Link Here
|
| 532 |
)->store(); |
596 |
)->store(); |
| 533 |
} |
597 |
} |
| 534 |
|
598 |
|
| 535 |
if ( $use_syspref_cache ) { |
599 |
if ( $self->{use_syspref_cache} ) { |
| 536 |
$syspref_cache->set_in_cache( "syspref_$variable", $value ); |
600 |
$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); |
| 537 |
} |
601 |
} |
| 538 |
|
602 |
|
| 539 |
return $syspref; |
603 |
return $syspref; |
|
Lines 551-560
was no syspref of the name.
Link Here
|
| 551 |
|
615 |
|
| 552 |
sub delete_preference { |
616 |
sub delete_preference { |
| 553 |
my ( $self, $var ) = @_; |
617 |
my ( $self, $var ) = @_; |
|
|
618 |
$self = $context unless ref $self; |
| 554 |
|
619 |
|
| 555 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
620 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
| 556 |
if ( $use_syspref_cache ) { |
621 |
if ( $self->{use_syspref_cache} ) { |
| 557 |
$syspref_cache->clear_from_cache("syspref_$var"); |
622 |
$self->{syspref_cache}->clear_from_cache("syspref_$var"); |
| 558 |
} |
623 |
} |
| 559 |
|
624 |
|
| 560 |
return 1; |
625 |
return 1; |
|
Lines 568-574
sub delete_preference {
Link Here
|
| 568 |
|
633 |
|
| 569 |
Returns a connection to the Zebra database |
634 |
Returns a connection to the Zebra database |
| 570 |
|
635 |
|
| 571 |
C<$self> |
636 |
C<$self> |
| 572 |
|
637 |
|
| 573 |
C<$server> one of the servers defined in the koha-conf.xml file |
638 |
C<$server> one of the servers defined in the koha-conf.xml file |
| 574 |
|
639 |
|
|
Lines 679-686
creates one, and connects to the database.
Link Here
|
| 679 |
|
744 |
|
| 680 |
This database handle is cached for future use: if you call |
745 |
This database handle is cached for future use: if you call |
| 681 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
746 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
| 682 |
times. If you need a second database handle, use C<&new_dbh> and |
747 |
times. If you need a second database handle, use C<&new_dbh>. |
| 683 |
possibly C<&set_dbh>. |
|
|
| 684 |
|
748 |
|
| 685 |
=cut |
749 |
=cut |
| 686 |
|
750 |
|
|
Lines 719-782
sub new_dbh
Link Here
|
| 719 |
return &dbh({ new => 1 }); |
783 |
return &dbh({ new => 1 }); |
| 720 |
} |
784 |
} |
| 721 |
|
785 |
|
| 722 |
=head2 set_dbh |
|
|
| 723 |
|
| 724 |
$my_dbh = C4::Connect->new_dbh; |
| 725 |
C4::Connect->set_dbh($my_dbh); |
| 726 |
... |
| 727 |
C4::Connect->restore_dbh; |
| 728 |
|
| 729 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
| 730 |
C<&set_context> and C<&restore_context>. |
| 731 |
|
| 732 |
C<&set_dbh> saves the current database handle on a stack, then sets |
| 733 |
the current database handle to C<$my_dbh>. |
| 734 |
|
| 735 |
C<$my_dbh> is assumed to be a good database handle. |
| 736 |
|
| 737 |
=cut |
| 738 |
|
| 739 |
#' |
| 740 |
sub set_dbh |
| 741 |
{ |
| 742 |
my $self = shift; |
| 743 |
my $new_dbh = shift; |
| 744 |
|
| 745 |
# Save the current database handle on the handle stack. |
| 746 |
# We assume that $new_dbh is all good: if the caller wants to |
| 747 |
# screw himself by passing an invalid handle, that's fine by |
| 748 |
# us. |
| 749 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
| 750 |
$context->{"dbh"} = $new_dbh; |
| 751 |
} |
| 752 |
|
| 753 |
=head2 restore_dbh |
| 754 |
|
| 755 |
C4::Context->restore_dbh; |
| 756 |
|
| 757 |
Restores the database handle saved by an earlier call to |
| 758 |
C<C4::Context-E<gt>set_dbh>. |
| 759 |
|
| 760 |
=cut |
| 761 |
|
| 762 |
#' |
| 763 |
sub restore_dbh |
| 764 |
{ |
| 765 |
my $self = shift; |
| 766 |
|
| 767 |
if ($#{$context->{"dbh_stack"}} < 0) |
| 768 |
{ |
| 769 |
# Stack underflow |
| 770 |
die "DBH stack underflow"; |
| 771 |
} |
| 772 |
|
| 773 |
# Pop the old database handle and set it. |
| 774 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
| 775 |
|
| 776 |
# FIXME - If it is determined that restore_context should |
| 777 |
# return something, then this function should, too. |
| 778 |
} |
| 779 |
|
| 780 |
=head2 queryparser |
786 |
=head2 queryparser |
| 781 |
|
787 |
|
| 782 |
$queryparser = C4::Context->queryparser |
788 |
$queryparser = C4::Context->queryparser |