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 104-109
use Koha::Cache;
Link Here
|
104 |
use POSIX (); |
104 |
use POSIX (); |
105 |
use DateTime::TimeZone; |
105 |
use DateTime::TimeZone; |
106 |
use Module::Load::Conditional qw(can_load); |
106 |
use Module::Load::Conditional qw(can_load); |
|
|
107 |
use Data::Dumper; |
107 |
use Carp; |
108 |
use Carp; |
108 |
|
109 |
|
109 |
use C4::Boolean; |
110 |
use C4::Boolean; |
Lines 171-180
environment variable to the pathname of a configuration file to use.
Link Here
|
171 |
# file (/etc/koha/koha-conf.xml). |
172 |
# file (/etc/koha/koha-conf.xml). |
172 |
# dbh |
173 |
# dbh |
173 |
# A handle to the appropriate database for this context. |
174 |
# A handle to the appropriate database for this context. |
174 |
# dbh_stack |
|
|
175 |
# Used by &set_dbh and &restore_dbh to hold other database |
176 |
# handles for this context. |
177 |
# Zconn |
178 |
# A connection object for the Zebra server |
175 |
# A connection object for the Zebra server |
179 |
|
176 |
|
180 |
# Koha's main configuration file koha-conf.xml |
177 |
# Koha's main configuration file koha-conf.xml |
Lines 183-189
environment variable to the pathname of a configuration file to use.
Link Here
|
183 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
180 |
# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' |
184 |
# 2. Path supplied in KOHA_CONF environment variable. |
181 |
# 2. Path supplied in KOHA_CONF environment variable. |
185 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
182 |
# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long |
186 |
# as value has changed from its default of |
183 |
# as value has changed from its default of |
187 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
184 |
# '__KOHA_CONF_DIR__/koha-conf.xml', as happens |
188 |
# when Koha is installed in 'standard' or 'single' |
185 |
# when Koha is installed in 'standard' or 'single' |
189 |
# mode. |
186 |
# mode. |
Lines 193-244
environment variable to the pathname of a configuration file to use.
Link Here
|
193 |
|
190 |
|
194 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
191 |
use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; |
195 |
# Default config file, if none is specified |
192 |
# Default config file, if none is specified |
196 |
|
193 |
|
197 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
194 |
my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; |
198 |
# path to config file set by installer |
195 |
# path to config file set by installer |
199 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
196 |
# __KOHA_CONF_DIR__ is set by rewrite-confg.PL |
200 |
# when Koha is installed in 'standard' or 'single' |
197 |
# when Koha is installed in 'standard' or 'single' |
201 |
# mode. If Koha was installed in 'dev' mode, |
198 |
# mode. If Koha was installed in 'dev' mode, |
202 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
199 |
# __KOHA_CONF_DIR__ is *not* rewritten; instead |
203 |
# developers should set the KOHA_CONF environment variable |
200 |
# developers should set the KOHA_CONF environment variable |
204 |
|
|
|
205 |
$context = undef; # Initially, no context is set |
206 |
@context_stack = (); # Initially, no saved contexts |
207 |
|
208 |
|
209 |
=head2 read_config_file |
210 |
|
211 |
Reads the specified Koha config file. |
212 |
|
213 |
Returns an object containing the configuration variables. The object's |
214 |
structure is a bit complex to the uninitiated ... take a look at the |
215 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
216 |
here are a few examples that may give you what you need: |
217 |
|
201 |
|
218 |
The simple elements nested within the <config> element: |
202 |
@context_stack = (); # Initially, no saved contexts |
219 |
|
203 |
|
220 |
my $pass = $koha->{'config'}->{'pass'}; |
204 |
=head2 current |
221 |
|
205 |
|
222 |
The <listen> elements: |
206 |
Returns the current context |
223 |
|
|
|
224 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
225 |
|
226 |
The elements nested within the <server> element: |
227 |
|
228 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
229 |
|
230 |
Returns undef in case of error. |
231 |
|
207 |
|
232 |
=cut |
208 |
=cut |
233 |
|
209 |
|
234 |
sub read_config_file { # Pass argument naming config file to read |
210 |
sub current { |
235 |
my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); |
211 |
return $context; |
236 |
|
|
|
237 |
if ($ismemcached) { |
238 |
$memcached->set('kohaconf',$koha); |
239 |
} |
240 |
|
241 |
return $koha; # Return value: ref-to-hash holding the configuration |
242 |
} |
212 |
} |
243 |
|
213 |
|
244 |
=head2 ismemcached |
214 |
=head2 ismemcached |
Lines 266-271
sub memcached {
Link Here
|
266 |
} |
236 |
} |
267 |
} |
237 |
} |
268 |
|
238 |
|
|
|
239 |
sub db_driver { |
240 |
my $self = shift; |
241 |
|
242 |
$self = $context unless ref ($self); |
243 |
return unless $self; |
244 |
|
245 |
return $self->{db_driver}; |
246 |
} |
247 |
|
269 |
=head2 db_scheme2dbi |
248 |
=head2 db_scheme2dbi |
270 |
|
249 |
|
271 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
250 |
my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); |
Lines 286-317
sub import {
Link Here
|
286 |
# Create the default context ($C4::Context::Context) |
265 |
# Create the default context ($C4::Context::Context) |
287 |
# the first time the module is called |
266 |
# the first time the module is called |
288 |
# (a config file can be optionaly passed) |
267 |
# (a config file can be optionaly passed) |
|
|
268 |
# If ":no_config" is passed, no config load will be attempted |
269 |
# Config file defaults to either the file given by the $KOHA_CONF |
270 |
# environment variable, or /etc/koha/koha-conf.xml. |
271 |
# It saves the context values in the declared memcached server(s) |
272 |
# if currently available and uses those values until them expire and |
273 |
# re-reads them. |
274 |
|
275 |
my ($pkg,$config_file) = @_ ; |
289 |
|
276 |
|
290 |
# default context already exists? |
277 |
# default context already exists? |
291 |
return if $context; |
278 |
return if $context; |
292 |
|
279 |
|
|
|
280 |
if ($ismemcached) { |
281 |
# retrieve from memcached |
282 |
if (my $self = $memcached->get('kohaconf')) { |
283 |
$context = $self; |
284 |
return; |
285 |
} |
286 |
} |
287 |
|
288 |
# check that the specified config file exists and is not empty |
289 |
undef $config_file if defined $config_file && |
290 |
!( ref($config_file) || openhandle($config_file) || -s $config_file ); |
291 |
# Figure out a good config file to load if none was specified. |
292 |
if (!defined($config_file)) |
293 |
{ |
294 |
# If the $KOHA_CONF environment variable is set, use |
295 |
# that. Otherwise, use the built-in default. |
296 |
if ($ENV{'KOHA_CONF'} and ref($ENV{'KOHA_CONF'}) || -s $ENV{"KOHA_CONF"}) { |
297 |
$config_file = $ENV{"KOHA_CONF"}; |
298 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
299 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
300 |
# regex to anything else -- don't want installer to rewrite it |
301 |
$config_file = $INSTALLED_CONFIG_FNAME; |
302 |
} elsif (-s CONFIG_FNAME) { |
303 |
$config_file = CONFIG_FNAME; |
304 |
} else { |
305 |
die "unable to locate Koha configuration file koha-conf.xml"; |
306 |
} |
307 |
} |
308 |
|
293 |
# no ? so load it! |
309 |
# no ? so load it! |
294 |
my ($pkg,$config_file) = @_ ; |
310 |
return if $config_file && $config_file eq ":no_config"; |
295 |
my $new_ctx = __PACKAGE__->new($config_file); |
311 |
my $new_ctx = __PACKAGE__->new($config_file); |
296 |
return unless $new_ctx; |
312 |
return unless $new_ctx; |
297 |
|
313 |
|
298 |
# if successfully loaded, use it by default |
314 |
# if successfully loaded, use it by default |
299 |
$new_ctx->set_context; |
315 |
$context = $new_ctx; |
300 |
1; |
316 |
|
|
|
317 |
if ($ismemcached) { |
318 |
$memcached->set('kohaconf',$new_ctx); |
319 |
} |
301 |
} |
320 |
} |
302 |
|
321 |
|
|
|
322 |
use Scalar::Util qw(openhandle); |
303 |
=head2 new |
323 |
=head2 new |
304 |
|
324 |
|
305 |
$context = new C4::Context; |
|
|
306 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
325 |
$context = new C4::Context("/path/to/koha-conf.xml"); |
307 |
|
326 |
|
308 |
Allocates a new context. Initializes the context from the specified |
327 |
Allocates a new context. Initializes the context from the specified |
309 |
file, which defaults to either the file given by the C<$KOHA_CONF> |
328 |
file. |
310 |
environment variable, or F</etc/koha/koha-conf.xml>. |
|
|
311 |
|
329 |
|
312 |
It saves the koha-conf.xml values in the declared memcached server(s) |
330 |
XML structure is a bit complex to the uninitiated ... take a look at the |
313 |
if currently available and uses those values until them expire and |
331 |
koha-conf.xml file as well as the XML::Simple documentation for details. Or, |
314 |
re-reads them. |
332 |
here are a few examples that may give you what you need: |
|
|
333 |
|
334 |
The simple elements nested within the <config> element: |
335 |
|
336 |
my $pass = $koha->{'config'}->{'pass'}; |
337 |
|
338 |
The <listen> elements: |
339 |
|
340 |
my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; |
341 |
|
342 |
The elements nested within the <server> element: |
343 |
|
344 |
my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; |
345 |
|
346 |
Returns undef in case of error. |
315 |
|
347 |
|
316 |
C<&new> does not set this context as the new default context; for |
348 |
C<&new> does not set this context as the new default context; for |
317 |
that, use C<&set_context>. |
349 |
that, use C<&set_context>. |
Lines 323-368
that, use C<&set_context>.
Link Here
|
323 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
355 |
# 2004-08-10 A. Tarallo: Added check if the conf file is not empty |
324 |
sub new { |
356 |
sub new { |
325 |
my $class = shift; |
357 |
my $class = shift; |
326 |
my $conf_fname = shift; # Config file to load |
358 |
my $conf_fname = shift or croak "No conf"; |
327 |
my $self = {}; |
359 |
my $namespace = shift; |
328 |
|
360 |
|
329 |
# check that the specified config file exists and is not empty |
361 |
my $self = XMLin( |
330 |
undef $conf_fname unless |
362 |
$conf_fname, |
331 |
(defined $conf_fname && -s $conf_fname); |
363 |
keyattr => ['id'], |
332 |
# Figure out a good config file to load if none was specified. |
364 |
forcearray => ['listen', 'server', 'serverinfo'], |
333 |
if (!defined($conf_fname)) |
365 |
suppressempty => '', |
334 |
{ |
366 |
); |
335 |
# If the $KOHA_CONF environment variable is set, use |
367 |
die "Invalid config ".(ref($conf_fname) ? $$conf_fname : $conf_fname).": ".Dumper($self) |
336 |
# that. Otherwise, use the built-in default. |
368 |
unless ref($self) && $self->{"config"}; |
337 |
if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) { |
|
|
338 |
$conf_fname = $ENV{"KOHA_CONF"}; |
339 |
} elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) { |
340 |
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above |
341 |
# regex to anything else -- don't want installer to rewrite it |
342 |
$conf_fname = $INSTALLED_CONFIG_FNAME; |
343 |
} elsif (-s CONFIG_FNAME) { |
344 |
$conf_fname = CONFIG_FNAME; |
345 |
} else { |
346 |
warn "unable to locate Koha configuration file koha-conf.xml"; |
347 |
return; |
348 |
} |
349 |
} |
350 |
|
351 |
if ($ismemcached) { |
352 |
# retrieve from memcached |
353 |
$self = $memcached->get('kohaconf'); |
354 |
if (not defined $self) { |
355 |
# not in memcached yet |
356 |
$self = read_config_file($conf_fname); |
357 |
} |
358 |
} else { |
359 |
# non-memcached env, read from file |
360 |
$self = read_config_file($conf_fname); |
361 |
} |
362 |
|
369 |
|
363 |
$self->{"config_file"} = $conf_fname; |
370 |
$self->{"config_file"} = $conf_fname; |
364 |
warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); |
371 |
$self->{"namespace"} = $namespace; |
365 |
return if !defined($self->{"config"}); |
|
|
366 |
|
372 |
|
367 |
$self->{"Zconn"} = undef; # Zebra Connections |
373 |
$self->{"Zconn"} = undef; # Zebra Connections |
368 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
374 |
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield |
Lines 379-385
sub new {
Link Here
|
379 |
|
385 |
|
380 |
=head2 set_context |
386 |
=head2 set_context |
381 |
|
387 |
|
382 |
$context = new C4::Context; |
|
|
383 |
$context->set_context(); |
388 |
$context->set_context(); |
384 |
or |
389 |
or |
385 |
set_context C4::Context $context; |
390 |
set_context C4::Context $context; |
Lines 409-421
sub set_context
Link Here
|
409 |
# break this assumption by playing silly buggers, but that's |
414 |
# break this assumption by playing silly buggers, but that's |
410 |
# harder to do than doing it properly, and harder to check |
415 |
# harder to do than doing it properly, and harder to check |
411 |
# for. |
416 |
# for. |
|
|
417 |
my $schema; |
412 |
if (ref($self) eq "") |
418 |
if (ref($self) eq "") |
413 |
{ |
419 |
{ |
414 |
# Class method. The new context is the next argument. |
420 |
# Class method. The new context is the next argument. |
415 |
$new_context = shift; |
421 |
$new_context = shift or croak "No new context"; |
|
|
422 |
$schema = Koha::Database->new_schema($new_context); |
416 |
} else { |
423 |
} else { |
417 |
# Instance method. The new context is $self. |
424 |
# Instance method. The new context is $self. |
418 |
$new_context = $self; |
425 |
$new_context = $self; |
|
|
426 |
|
427 |
# undef $self->{schema} if $self->{schema} && !$self->{schema}->ping |
428 |
$schema = $self->{schema} ||= Koha::Database->new_schema($self); |
419 |
} |
429 |
} |
420 |
|
430 |
|
421 |
# Save the old context, if any, on the stack |
431 |
# Save the old context, if any, on the stack |
Lines 423-428
sub set_context
Link Here
|
423 |
|
433 |
|
424 |
# Set the new context |
434 |
# Set the new context |
425 |
$context = $new_context; |
435 |
$context = $new_context; |
|
|
436 |
Koha::Database->set_schema($schema); |
426 |
} |
437 |
} |
427 |
|
438 |
|
428 |
=head2 restore_context |
439 |
=head2 restore_context |
Lines 438-456
sub restore_context
Link Here
|
438 |
{ |
449 |
{ |
439 |
my $self = shift; |
450 |
my $self = shift; |
440 |
|
451 |
|
441 |
if ($#context_stack < 0) |
|
|
442 |
{ |
443 |
# Stack underflow. |
444 |
die "Context stack underflow"; |
445 |
} |
446 |
|
447 |
# Pop the old context and set it. |
452 |
# Pop the old context and set it. |
448 |
$context = pop @context_stack; |
453 |
$context = pop @context_stack; |
|
|
454 |
Koha::Database->restore_schema(); |
449 |
|
455 |
|
450 |
# FIXME - Should this return something, like maybe the context |
456 |
# FIXME - Should this return something, like maybe the context |
451 |
# that was current when this was called? |
457 |
# that was current when this was called? |
452 |
} |
458 |
} |
453 |
|
459 |
|
|
|
460 |
=head2 run_within_context |
461 |
|
462 |
$context->run_within_context(sub {...}); |
463 |
|
464 |
Runs code within context |
465 |
|
466 |
=cut |
467 |
|
468 |
#' |
469 |
sub run_within_context |
470 |
{ |
471 |
my $self = shift; |
472 |
my $code = shift or croak "No code"; |
473 |
|
474 |
$self->set_context; |
475 |
|
476 |
local $@; |
477 |
my $ret = eval { $code->(@_) }; |
478 |
my $died = $@; |
479 |
$self->restore_context; |
480 |
die $died if $died; |
481 |
return $ret; |
482 |
} |
483 |
|
454 |
=head2 config |
484 |
=head2 config |
455 |
|
485 |
|
456 |
$value = C4::Context->config("config_variable"); |
486 |
$value = C4::Context->config("config_variable"); |
Lines 467-492
C<C4::Config-E<gt>new> will not return it.
Link Here
|
467 |
=cut |
497 |
=cut |
468 |
|
498 |
|
469 |
sub _common_config { |
499 |
sub _common_config { |
470 |
my $var = shift; |
500 |
my $self = shift; |
471 |
my $term = shift; |
501 |
my $var = shift; |
472 |
return if !defined($context->{$term}); |
502 |
my $term = shift; |
|
|
503 |
|
504 |
$self = $context unless ref $self; |
505 |
return if !defined($self->{$term}); |
473 |
# Presumably $self->{$term} might be |
506 |
# Presumably $self->{$term} might be |
474 |
# undefined if the config file given to &new |
507 |
# undefined if the config file given to &new |
475 |
# didn't exist, and the caller didn't bother |
508 |
# didn't exist, and the caller didn't bother |
476 |
# to check the return value. |
509 |
# to check the return value. |
477 |
|
510 |
|
478 |
# Return the value of the requested config variable |
511 |
# Return the value of the requested config variable |
479 |
return $context->{$term}->{$var}; |
512 |
return $self->{$term}->{$var}; |
480 |
} |
513 |
} |
481 |
|
514 |
|
482 |
sub config { |
515 |
sub config { |
483 |
return _common_config($_[1],'config'); |
516 |
my $self = shift; |
|
|
517 |
return $self->_common_config($_[0],'config'); |
484 |
} |
518 |
} |
485 |
sub zebraconfig { |
519 |
sub zebraconfig { |
486 |
return _common_config($_[1],'server'); |
520 |
my $self = shift; |
|
|
521 |
return $self->_common_config($_[0],'server'); |
487 |
} |
522 |
} |
488 |
sub ModZebrations { |
523 |
sub ModZebrations { |
489 |
return _common_config($_[1],'serverinfo'); |
524 |
my $self = shift; |
|
|
525 |
return $self->_common_config($_[0],'serverinfo'); |
490 |
} |
526 |
} |
491 |
|
527 |
|
492 |
=head2 preference |
528 |
=head2 preference |
Lines 685-691
sub delete_preference {
Link Here
|
685 |
|
721 |
|
686 |
Returns a connection to the Zebra database |
722 |
Returns a connection to the Zebra database |
687 |
|
723 |
|
688 |
C<$self> |
724 |
C<$self> |
689 |
|
725 |
|
690 |
C<$server> one of the servers defined in the koha-conf.xml file |
726 |
C<$server> one of the servers defined in the koha-conf.xml file |
691 |
|
727 |
|
Lines 796-803
creates one, and connects to the database.
Link Here
|
796 |
|
832 |
|
797 |
This database handle is cached for future use: if you call |
833 |
This database handle is cached for future use: if you call |
798 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
834 |
C<C4::Context-E<gt>dbh> twice, you will get the same handle both |
799 |
times. If you need a second database handle, use C<&new_dbh> and |
835 |
times. If you need a second database handle, use C<&new_dbh>. |
800 |
possibly C<&set_dbh>. |
|
|
801 |
|
836 |
|
802 |
=cut |
837 |
=cut |
803 |
|
838 |
|
Lines 836-899
sub new_dbh
Link Here
|
836 |
return &dbh({ new => 1 }); |
871 |
return &dbh({ new => 1 }); |
837 |
} |
872 |
} |
838 |
|
873 |
|
839 |
=head2 set_dbh |
|
|
840 |
|
841 |
$my_dbh = C4::Connect->new_dbh; |
842 |
C4::Connect->set_dbh($my_dbh); |
843 |
... |
844 |
C4::Connect->restore_dbh; |
845 |
|
846 |
C<&set_dbh> and C<&restore_dbh> work in a manner analogous to |
847 |
C<&set_context> and C<&restore_context>. |
848 |
|
849 |
C<&set_dbh> saves the current database handle on a stack, then sets |
850 |
the current database handle to C<$my_dbh>. |
851 |
|
852 |
C<$my_dbh> is assumed to be a good database handle. |
853 |
|
854 |
=cut |
855 |
|
856 |
#' |
857 |
sub set_dbh |
858 |
{ |
859 |
my $self = shift; |
860 |
my $new_dbh = shift; |
861 |
|
862 |
# Save the current database handle on the handle stack. |
863 |
# We assume that $new_dbh is all good: if the caller wants to |
864 |
# screw himself by passing an invalid handle, that's fine by |
865 |
# us. |
866 |
push @{$context->{"dbh_stack"}}, $context->{"dbh"}; |
867 |
$context->{"dbh"} = $new_dbh; |
868 |
} |
869 |
|
870 |
=head2 restore_dbh |
871 |
|
872 |
C4::Context->restore_dbh; |
873 |
|
874 |
Restores the database handle saved by an earlier call to |
875 |
C<C4::Context-E<gt>set_dbh>. |
876 |
|
877 |
=cut |
878 |
|
879 |
#' |
880 |
sub restore_dbh |
881 |
{ |
882 |
my $self = shift; |
883 |
|
884 |
if ($#{$context->{"dbh_stack"}} < 0) |
885 |
{ |
886 |
# Stack underflow |
887 |
die "DBH stack underflow"; |
888 |
} |
889 |
|
890 |
# Pop the old database handle and set it. |
891 |
$context->{"dbh"} = pop @{$context->{"dbh_stack"}}; |
892 |
|
893 |
# FIXME - If it is determined that restore_context should |
894 |
# return something, then this function should, too. |
895 |
} |
896 |
|
897 |
=head2 queryparser |
874 |
=head2 queryparser |
898 |
|
875 |
|
899 |
$queryparser = C4::Context->queryparser |
876 |
$queryparser = C4::Context->queryparser |