|
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 |
|
101 |
|
| 101 |
use C4::Boolean; |
102 |
use C4::Boolean; |
|
Lines 164-177
environment variable to the pathname of a configuration file to use.
Link Here
|
| 164 |
# file (/etc/koha/koha-conf.xml). |
165 |
# file (/etc/koha/koha-conf.xml). |
| 165 |
# dbh |
166 |
# dbh |
| 166 |
# A handle to the appropriate database for this context. |
167 |
# A handle to the appropriate database for this context. |
| 167 |
# dbh_stack |
|
|
| 168 |
# Used by &set_dbh and &restore_dbh to hold other database |
| 169 |
# handles for this context. |
| 170 |
# Zconn |
| 171 |
# A connection object for the Zebra server |
168 |
# A connection object for the Zebra server |
| 172 |
|
169 |
|
| 173 |
$context = undef; # Initially, no context is set |
170 |
@context_stack = (); # Initially, no saved contexts |
| 174 |
@context_stack = (); # Initially, no saved contexts |
171 |
|
|
|
172 |
=head2 current |
| 173 |
|
| 174 |
Returns the current context |
| 175 |
|
| 176 |
=cut |
| 177 |
|
| 178 |
sub current { |
| 179 |
return $context; |
| 180 |
} |
| 181 |
|
| 182 |
sub db_driver { |
| 183 |
my $self = shift; |
| 184 |
|
| 185 |
$self = $context unless ref ($self); |
| 186 |
return unless $self; |
| 187 |
|
| 188 |
return $self->{db_driver}; |
| 189 |
} |
| 175 |
|
190 |
|
| 176 |
=head2 db_scheme2dbi |
191 |
=head2 db_scheme2dbi |
| 177 |
|
192 |
|
|
Lines 193-224
sub import {
Link Here
|
| 193 |
# Create the default context ($C4::Context::Context) |
208 |
# Create the default context ($C4::Context::Context) |
| 194 |
# the first time the module is called |
209 |
# the first time the module is called |
| 195 |
# (a config file can be optionaly passed) |
210 |
# (a config file can be optionaly passed) |
|
|
211 |
# If ":no_config" is passed, no config load will be attempted |
| 212 |
# It saves the context values in the declared memcached server(s) |
| 213 |
# if currently available and uses those values until them expire and |
| 214 |
# re-reads them. |
| 215 |
|
| 216 |
my ($pkg,$config_file) = @_; |
| 196 |
|
217 |
|
| 197 |
# default context already exists? |
218 |
# default context already exists? |
| 198 |
return if $context; |
219 |
return if $context; |
| 199 |
|
220 |
|
| 200 |
# no ? so load it! |
221 |
# multihost, we don't want/have one default config |
| 201 |
my ($pkg,$config_file) = @_ ; |
222 |
return if $config_file && $config_file eq ":no_config"; |
| 202 |
my $new_ctx = __PACKAGE__->new($config_file); |
|
|
| 203 |
return unless $new_ctx; |
| 204 |
|
223 |
|
| 205 |
# if successfully loaded, use it by default |
224 |
my $conf_cache = Koha::Caches->get_instance('config'); |
| 206 |
$new_ctx->set_context; |
225 |
if ( $conf_cache->cache ) { |
| 207 |
1; |
226 |
if ( $context = $conf_cache->get_from_cache('koha_conf') ) { |
|
|
227 |
return; |
| 228 |
} |
| 229 |
} |
| 230 |
|
| 231 |
undef $config_file if $config_file && !-s $config_file; |
| 232 |
$config_file ||= Koha::Config->guess_koha_conf(); |
| 233 |
$context = __PACKAGE__->new($config_file); |
| 234 |
return unless $context; |
| 235 |
|
| 236 |
if ( $conf_cache->memcached_cache ) { |
| 237 |
# FIXME it may be better to use the memcached servers from the config file |
| 238 |
# to cache it |
| 239 |
$conf_cache->set_in_cache('koha_conf', $context) |
| 240 |
} |
| 208 |
} |
241 |
} |
| 209 |
|
242 |
|
| 210 |
=head2 new |
243 |
=head2 new |
| 211 |
|
244 |
|
| 212 |
$context = new C4::Context; |
|
|
| 213 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
245 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
| 214 |
|
246 |
|
| 215 |
Allocates a new context. Initializes the context from the specified |
247 |
Allocates a new context. Initializes the context from the specified |
| 216 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
248 |
file. |
| 217 |
environment variable, or F</etc/koha/koha-conf.xml>. |
|
|
| 218 |
|
| 219 |
It saves the koha-conf.xml values in the declared memcached server(s) |
| 220 |
if currently available and uses those values until them expire and |
| 221 |
re-reads them. |
| 222 |
|
249 |
|
| 223 |
C<&new> does not set this context as the new default context; for |
250 |
C<&new> does not set this context as the new default context; for |
| 224 |
that, use C<&set_context>. |
251 |
that, use C<&set_context>. |
|
Lines 230-267
that, use C<&set_context>.
Link Here
|
| 230 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
257 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
| 231 |
sub new { |
258 |
sub new { |
| 232 |
my $class = shift; |
259 |
my $class = shift; |
| 233 |
my $conf_fname = shift; # Config file to load |
260 |
my $conf_fname = shift or croak "No conf"; |
| 234 |
my $self = {}; |
261 |
my $namespace = shift; |
| 235 |
|
|
|
| 236 |
# check that the specified config file exists and is not empty |
| 237 |
undef $conf_fname unless |
| 238 |
(defined $conf_fname && -s $conf_fname); |
| 239 |
# Figure out a good config file to load if none was specified. |
| 240 |
unless ( defined $conf_fname ) { |
| 241 |
$conf_fname = Koha::Config->guess_koha_conf; |
| 242 |
unless ( $conf_fname ) { |
| 243 |
warn "unable to locate Koha configuration file koha-conf.xml"; |
| 244 |
return; |
| 245 |
} |
| 246 |
} |
| 247 |
|
262 |
|
| 248 |
my $conf_cache = Koha::Caches->get_instance('config'); |
263 |
my $self = Koha::Config->read_from_file($conf_fname); |
| 249 |
my $config_from_cache; |
264 |
die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) |
| 250 |
if ( $conf_cache->cache ) { |
265 |
unless ref($self) && $self->{"config"}; |
| 251 |
$self = $conf_cache->get_from_cache('koha_conf'); |
266 |
|
| 252 |
} |
267 |
$self->{config_file} = $conf_fname; |
| 253 |
unless ( $self and %$self ) { |
268 |
$self->{namespace} = $namespace; |
| 254 |
$self = Koha::Config->read_from_file($conf_fname); |
269 |
$self->{use_syspref_cache} = 1; |
| 255 |
if ( $conf_cache->memcached_cache ) { |
270 |
$self->{syspref_cache} = Koha::Caches->get_instance('syspref', $namespace); |
| 256 |
# FIXME it may be better to use the memcached servers from the config file |
|
|
| 257 |
# to cache it |
| 258 |
$conf_cache->set_in_cache('koha_conf', $self) |
| 259 |
} |
| 260 |
} |
| 261 |
unless ( exists $self->{config} or defined $self->{config} ) { |
| 262 |
warn "The config file ($conf_fname) has not been parsed correctly"; |
| 263 |
return; |
| 264 |
} |
| 265 |
|
271 |
|
| 266 |
$self->{"Zconn"} = undef; # Zebra Connections |
272 |
$self->{"Zconn"} = undef; # Zebra Connections |
| 267 |
$self->{"userenv"} = undef; # User env |
273 |
$self->{"userenv"} = undef; # User env |
|
Lines 276-282
sub new {
Link Here
|
| 276 |
|
282 |
|
| 277 |
=head2 set_context |
283 |
=head2 set_context |
| 278 |
|
284 |
|
| 279 |
$context = new C4::Context; |
|
|
| 280 |
$context->set_context(); |
285 |
$context->set_context(); |
| 281 |
or |
286 |
or |
| 282 |
set_context C4::Context $context; |
287 |
set_context C4::Context $context; |
|
Lines 309-325
sub set_context
Link Here
|
| 309 |
if (ref($self) eq "") |
314 |
if (ref($self) eq "") |
| 310 |
{ |
315 |
{ |
| 311 |
# Class method. The new context is the next argument. |
316 |
# Class method. The new context is the next argument. |
| 312 |
$new_context = shift; |
317 |
$new_context = shift or croak "No new context"; |
| 313 |
} else { |
318 |
} else { |
| 314 |
# Instance method. The new context is $self. |
319 |
# Instance method. The new context is $self. |
| 315 |
$new_context = $self; |
320 |
$new_context = $self; |
| 316 |
} |
321 |
} |
| 317 |
|
322 |
|
| 318 |
# Save the old context, if any, on the stack |
323 |
# undef $new_context->{schema} if $new_context->{schema} && !$new_context->{schema}->ping |
| 319 |
push @context_stack, $context if defined($context); |
324 |
my $schema = $new_context->{schema} ||= Koha::Database->new_schema($new_context); |
|
|
325 |
|
| 326 |
# Save the old context on the stack |
| 327 |
push @context_stack, $context; |
| 320 |
|
328 |
|
| 321 |
# Set the new context |
329 |
# Set the new context |
| 322 |
$context = $new_context; |
330 |
$context = $new_context; |
|
|
331 |
Koha::Database->set_schema($schema); |
| 323 |
} |
332 |
} |
| 324 |
|
333 |
|
| 325 |
=head2 restore_context |
334 |
=head2 restore_context |
|
Lines 335-353
sub restore_context
Link Here
|
| 335 |
{ |
344 |
{ |
| 336 |
my $self = shift; |
345 |
my $self = shift; |
| 337 |
|
346 |
|
| 338 |
if ($#context_stack < 0) |
|
|
| 339 |
{ |
| 340 |
# Stack underflow. |
| 341 |
die "Context stack underflow"; |
| 342 |
} |
| 343 |
|
| 344 |
# Pop the old context and set it. |
347 |
# Pop the old context and set it. |
| 345 |
$context = pop @context_stack; |
348 |
$context = pop @context_stack; |
|
|
349 |
Koha::Database->restore_schema(); |
| 346 |
|
350 |
|
| 347 |
# FIXME - Should this return something, like maybe the context |
351 |
# FIXME - Should this return something, like maybe the context |
| 348 |
# that was current when this was called? |
352 |
# that was current when this was called? |
| 349 |
} |
353 |
} |
| 350 |
|
354 |
|
|
|
355 |
=head2 run_within_context |
| 356 |
|
| 357 |
$context->run_within_context(sub {...}); |
| 358 |
|
| 359 |
Runs code within context |
| 360 |
|
| 361 |
=cut |
| 362 |
|
| 363 |
#' |
| 364 |
sub run_within_context |
| 365 |
{ |
| 366 |
my $self = shift; |
| 367 |
my $code = shift or croak "No code"; |
| 368 |
|
| 369 |
$self->set_context; |
| 370 |
|
| 371 |
local $@; |
| 372 |
my $ret = eval { $code->(@_) }; |
| 373 |
my $died = $@; |
| 374 |
$self->restore_context; |
| 375 |
die $died if $died; |
| 376 |
return $ret; |
| 377 |
} |
| 378 |
|
| 351 |
=head2 config |
379 |
=head2 config |
| 352 |
|
380 |
|
| 353 |
$value = C4::Context->config("config_variable"); |
381 |
$value = C4::Context->config("config_variable"); |
|
Lines 364-389
C<C4::Config-E<gt>new> will not return it.
Link Here
|
| 364 |
=cut |
392 |
=cut |
| 365 |
|
393 |
|
| 366 |
sub _common_config { |
394 |
sub _common_config { |
| 367 |
my $var = shift; |
395 |
my $self = shift; |
| 368 |
my $term = shift; |
396 |
my $var = shift; |
| 369 |
return if !defined($context->{$term}); |
397 |
my $term = shift; |
|
|
398 |
|
| 399 |
$self = $context unless ref $self; |
| 400 |
return if !defined($self->{$term}); |
| 370 |
# Presumably $self->{$term} might be |
401 |
# Presumably $self->{$term} might be |
| 371 |
# undefined if the config file given to &new |
402 |
# undefined if the config file given to &new |
| 372 |
# didn't exist, and the caller didn't bother |
403 |
# didn't exist, and the caller didn't bother |
| 373 |
# to check the return value. |
404 |
# to check the return value. |
| 374 |
|
405 |
|
| 375 |
# Return the value of the requested config variable |
406 |
# Return the value of the requested config variable |
| 376 |
return $context->{$term}->{$var}; |
407 |
return $self->{$term}->{$var}; |
| 377 |
} |
408 |
} |
| 378 |
|
409 |
|
| 379 |
sub config { |
410 |
sub config { |
| 380 |
return _common_config($_[1],'config'); |
411 |
my $self = shift; |
|
|
412 |
return $self->_common_config($_[0],'config'); |
| 381 |
} |
413 |
} |
| 382 |
sub zebraconfig { |
414 |
sub zebraconfig { |
| 383 |
return _common_config($_[1],'server'); |
415 |
my $self = shift; |
|
|
416 |
return $self->_common_config($_[0],'server'); |
| 384 |
} |
417 |
} |
| 385 |
sub ModZebrations { |
418 |
sub ModZebrations { |
| 386 |
return _common_config($_[1],'serverinfo'); |
419 |
my $self = shift; |
|
|
420 |
return $self->_common_config($_[0],'serverinfo'); |
| 387 |
} |
421 |
} |
| 388 |
|
422 |
|
| 389 |
=head2 preference |
423 |
=head2 preference |
|
Lines 402-430
with this method.
Link Here
|
| 402 |
|
436 |
|
| 403 |
=cut |
437 |
=cut |
| 404 |
|
438 |
|
| 405 |
my $syspref_cache = Koha::Caches->get_instance('syspref'); |
|
|
| 406 |
my $use_syspref_cache = 1; |
| 407 |
sub preference { |
439 |
sub preference { |
| 408 |
my $self = shift; |
440 |
my $self = shift; |
|
|
441 |
$self = $context unless ref $self; |
| 409 |
my $var = shift; # The system preference to return |
442 |
my $var = shift; # The system preference to return |
| 410 |
|
443 |
|
|
|
444 |
$var = lc $var; |
| 445 |
|
| 411 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
446 |
return $ENV{"OVERRIDE_SYSPREF_$var"} |
| 412 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
447 |
if defined $ENV{"OVERRIDE_SYSPREF_$var"}; |
| 413 |
|
448 |
|
| 414 |
$var = lc $var; |
449 |
my $cached_var = $self->{use_syspref_cache} |
| 415 |
|
450 |
? $self->{syspref_cache}->get_from_cache("syspref_$var") |
| 416 |
if ($use_syspref_cache) { |
451 |
: undef; |
| 417 |
$syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache; |
452 |
return $cached_var if defined $cached_var; |
| 418 |
my $cached_var = $syspref_cache->get_from_cache("syspref_$var"); |
|
|
| 419 |
return $cached_var if defined $cached_var; |
| 420 |
} |
| 421 |
|
453 |
|
| 422 |
my $syspref; |
454 |
my $syspref; |
| 423 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
455 |
eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; |
| 424 |
my $value = $syspref ? $syspref->value() : undef; |
456 |
my $value = $syspref ? $syspref->value() : undef; |
| 425 |
|
457 |
|
| 426 |
if ( $use_syspref_cache ) { |
458 |
if ( $self->{use_syspref_cache} ) { |
| 427 |
$syspref_cache->set_in_cache("syspref_$var", $value); |
459 |
$self->{syspref_cache}->set_in_cache("syspref_$var", $value); |
| 428 |
} |
460 |
} |
| 429 |
return $value; |
461 |
return $value; |
| 430 |
} |
462 |
} |
|
Lines 447-453
default behavior.
Link Here
|
| 447 |
|
479 |
|
| 448 |
sub enable_syspref_cache { |
480 |
sub enable_syspref_cache { |
| 449 |
my ($self) = @_; |
481 |
my ($self) = @_; |
| 450 |
$use_syspref_cache = 1; |
482 |
$self = $context unless ref $self; |
|
|
483 |
$self->{use_syspref_cache} = 1; |
| 451 |
# We need to clear the cache to have it up-to-date |
484 |
# We need to clear the cache to have it up-to-date |
| 452 |
$self->clear_syspref_cache(); |
485 |
$self->clear_syspref_cache(); |
| 453 |
} |
486 |
} |
|
Lines 463-469
used with Plack and other persistent environments.
Link Here
|
| 463 |
|
496 |
|
| 464 |
sub disable_syspref_cache { |
497 |
sub disable_syspref_cache { |
| 465 |
my ($self) = @_; |
498 |
my ($self) = @_; |
| 466 |
$use_syspref_cache = 0; |
499 |
$self = $context unless ref $self; |
|
|
500 |
$self->{use_syspref_cache} = 0; |
| 467 |
$self->clear_syspref_cache(); |
501 |
$self->clear_syspref_cache(); |
| 468 |
} |
502 |
} |
| 469 |
|
503 |
|
|
Lines 478-485
will not be seen by this process.
Link Here
|
| 478 |
=cut |
512 |
=cut |
| 479 |
|
513 |
|
| 480 |
sub clear_syspref_cache { |
514 |
sub clear_syspref_cache { |
| 481 |
return unless $use_syspref_cache; |
515 |
my ($self) = @_; |
| 482 |
$syspref_cache->flush_all; |
516 |
$self = $context unless ref $self; |
|
|
517 |
return unless $self->{use_syspref_cache}; |
| 518 |
$self->{syspref_cache}->flush_all; |
| 483 |
} |
519 |
} |
| 484 |
|
520 |
|
| 485 |
=head2 set_preference |
521 |
=head2 set_preference |
|
Lines 495-500
preference.
Link Here
|
| 495 |
|
531 |
|
| 496 |
sub set_preference { |
532 |
sub set_preference { |
| 497 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
533 |
my ( $self, $variable, $value, $explanation, $type, $options ) = @_; |
|
|
534 |
$self = $context unless ref $self; |
| 498 |
|
535 |
|
| 499 |
$variable = lc $variable; |
536 |
$variable = lc $variable; |
| 500 |
|
537 |
|
|
Lines 530-537
sub set_preference {
Link Here
|
| 530 |
)->store(); |
567 |
)->store(); |
| 531 |
} |
568 |
} |
| 532 |
|
569 |
|
| 533 |
if ( $use_syspref_cache ) { |
570 |
if ( $self->{use_syspref_cache} ) { |
| 534 |
$syspref_cache->set_in_cache( "syspref_$variable", $value ); |
571 |
$self->{syspref_cache}->set_in_cache( "syspref_$variable", $value ); |
| 535 |
} |
572 |
} |
| 536 |
|
573 |
|
| 537 |
return $syspref; |
574 |
return $syspref; |
|
Lines 549-558
was no syspref of the name.
Link Here
|
| 549 |
|
586 |
|
| 550 |
sub delete_preference { |
587 |
sub delete_preference { |
| 551 |
my ( $self, $var ) = @_; |
588 |
my ( $self, $var ) = @_; |
|
|
589 |
$self = $context unless ref $self; |
| 552 |
|
590 |
|
| 553 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
591 |
if ( Koha::Config::SysPrefs->find( $var )->delete ) { |
| 554 |
if ( $use_syspref_cache ) { |
592 |
if ( $self->{use_syspref_cache} ) { |
| 555 |
$syspref_cache->clear_from_cache("syspref_$var"); |
593 |
$self->{syspref_cache}->clear_from_cache("syspref_$var"); |
| 556 |
} |
594 |
} |
| 557 |
|
595 |
|
| 558 |
return 1; |
596 |
return 1; |
|
Lines 566-572
sub delete_preference {
Link Here
|
| 566 |
|
604 |
|
| 567 |
Returns a connection to the Zebra database |
605 |
Returns a connection to the Zebra database |
| 568 |
|
606 |
|
| 569 |
C<$self> |
607 |
C<$self> |
| 570 |
|
608 |
|
| 571 |
C<$server> one of the servers defined in the koha-conf.xml file |
609 |
C<$server> one of the servers defined in the koha-conf.xml file |
| 572 |
|
610 |
|
|
Lines 677-684
creates one, and connects to the database.
Link Here
|
| 677 |
|
715 |
|
| 678 |
This database handle is cached for future use: if you call |
716 |
This database handle is cached for future use: if you call |
| 679 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
717 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
| 680 |
times. If you need a second database handle, use C<&new_dbh> and |
718 |
times. If you need a second database handle, use C<&new_dbh>. |
| 681 |
possibly C<&set_dbh>. |
|
|
| 682 |
|
719 |
|
| 683 |
=cut |
720 |
=cut |
| 684 |
|
721 |
|
|
Lines 717-780
sub new_dbh
Link Here
|
| 717 |
return &dbh({ new => 1 }); |
754 |
return &dbh({ new => 1 }); |
| 718 |
} |
755 |
} |
| 719 |
|
756 |
|
| 720 |
=head2 set_dbh |
|
|
| 721 |
|
| 722 |
$my_dbh = C4::Connect->new_dbh; |
| 723 |
C4::Connect->set_dbh($my_dbh); |
| 724 |
... |
| 725 |
C4::Connect->restore_dbh; |
| 726 |
|
| 727 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
| 728 |
C<&set_context> and C<&restore_context>. |
| 729 |
|
| 730 |
C<&set_dbh> saves the current database handle on a stack, then sets |
| 731 |
the current database handle to C<$my_dbh>. |
| 732 |
|
| 733 |
C<$my_dbh> is assumed to be a good database handle. |
| 734 |
|
| 735 |
=cut |
| 736 |
|
| 737 |
#' |
| 738 |
sub set_dbh |
| 739 |
{ |
| 740 |
my $self = shift; |
| 741 |
my $new_dbh = shift; |
| 742 |
|
| 743 |
# Save the current database handle on the handle stack. |
| 744 |
# We assume that $new_dbh is all good: if the caller wants to |
| 745 |
# screw himself by passing an invalid handle, that's fine by |
| 746 |
# us. |
| 747 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
| 748 |
$context->{"dbh"} = $new_dbh; |
| 749 |
} |
| 750 |
|
| 751 |
=head2 restore_dbh |
| 752 |
|
| 753 |
C4::Context->restore_dbh; |
| 754 |
|
| 755 |
Restores the database handle saved by an earlier call to |
| 756 |
C<C4::Context-E<gt>set_dbh>. |
| 757 |
|
| 758 |
=cut |
| 759 |
|
| 760 |
#' |
| 761 |
sub restore_dbh |
| 762 |
{ |
| 763 |
my $self = shift; |
| 764 |
|
| 765 |
if ($#{$context->{"dbh_stack"}} < 0) |
| 766 |
{ |
| 767 |
# Stack underflow |
| 768 |
die "DBH stack underflow"; |
| 769 |
} |
| 770 |
|
| 771 |
# Pop the old database handle and set it. |
| 772 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
| 773 |
|
| 774 |
# FIXME - If it is determined that restore_context should |
| 775 |
# return something, then this function should, too. |
| 776 |
} |
| 777 |
|
| 778 |
=head2 queryparser |
757 |
=head2 queryparser |
| 779 |
|
758 |
|
| 780 |
$queryparser = C4::Context->queryparser |
759 |
$queryparser = C4::Context->queryparser |