# Suite 330, Boston, MA 02111-1307 USA
use strict;
+use vars qw($VERSION $AUTOLOAD $context @context_stack);
BEGIN {
if ($ENV{'HTTP_USER_AGENT'}) {
require CGI::Carp;
+ # FIXME for future reference, CGI::Carp doc says
+ # "Note that fatalsToBrowser does not work with mod_perl version 2.0 and higher."
import CGI::Carp qw(fatalsToBrowser);
sub handle_errors {
my $msg = shift;
my $debug_level = C4::Context->preference("DebugLevel");
+ print q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
+ "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+ <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
+ <head><title>Koha Error</title></head>
+ <body>
+ );
if ($debug_level eq "2"){
# debug 2 , print extra info too.
my %versions = get_versions();
# a little example table with various version info";
print "
- <h1>debug level $debug_level </h1>
- <p>Got an error: $msg</p>
+ <h1>Koha error</h1>
+ <p>The following fatal error has occurred:</p>
+ <pre><code>$msg</code></pre>
<table>
- <tr><th>Apache<td> $versions{apacheVersion}</tr>
- <tr><th>Koha<td> $versions{kohaVersion}</tr>
- <tr><th>MySQL<td> $versions{mysqlVersion}</tr>
- <tr><th>OS<td> $versions{osVersion}</tr>
- <tr><th>Perl<td> $versions{perlVersion}</tr>
+ <tr><th>Apache</th><td> $versions{apacheVersion}</td></tr>
+ <tr><th>Koha</th><td> $versions{kohaVersion}</td></tr>
+ <tr><th>Koha DB</th><td> $versions{kohaDbVersion}</td></tr>
+ <tr><th>MySQL</th><td> $versions{mysqlVersion}</td></tr>
+ <tr><th>OS</th><td> $versions{osVersion}</td></tr>
+ <tr><th>Perl</th><td> $versions{perlVersion}</td></tr>
</table>";
} elsif ($debug_level eq "1"){
- print "<h1>debug level $debug_level </h1>";
- print "<p>Got an error: $msg</p>";
+ print "
+ <h1>Koha error</h1>
+ <p>The following fatal error has occurred:</p>
+ <pre><code>$msg</code></pre>";
} else {
- print "production mode - trapped fatal";
+ print "<p>production mode - trapped fatal error</p>";
}
- }
- CGI::Carp->set_message(\&handle_errors);
+ print "</body></html>";
+ }
+ CGI::Carp::set_message(\&handle_errors);
+ ## give a stack backtrace if KOHA_BACKTRACES is set
+ ## can't rely on DebugLevel for this, as we're not yet connected
+ if ($ENV{KOHA_BACKTRACES}) {
+ $main::SIG{__DIE__} = \&CGI::Carp::confess;
+ }
} # else there is no browser to send fatals to!
+ $VERSION = '3.00.00.036';
}
use DBI;
use ZOOM;
use XML::Simple;
-
use C4::Boolean;
-use vars qw($VERSION $AUTOLOAD $context @context_stack);
-
-$VERSION = '3.00.00.036';
-
=head1 NAME
C4::Context - Maintain and manipulate the context of a Koha script
# check that the specified config file exists and is not empty
undef $conf_fname unless
- (defined $conf_fname && -e $conf_fname && -s $conf_fname);
+ (defined $conf_fname && -s $conf_fname);
# Figure out a good config file to load if none was specified.
if (!defined($conf_fname))
{
# If the $KOHA_CONF environment variable is set, use
# that. Otherwise, use the built-in default.
- if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -e $ENV{"KOHA_CONF"} and -s $ENV{"KOHA_CONF"}) {
+ if (exists $ENV{"KOHA_CONF"} and $ENV{'KOHA_CONF'} and -s $ENV{"KOHA_CONF"}) {
$conf_fname = $ENV{"KOHA_CONF"};
- } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -e $INSTALLED_CONFIG_FNAME and -s $INSTALLED_CONFIG_FNAME) {
+ } elsif ($INSTALLED_CONFIG_FNAME !~ /__KOHA_CONF_DIR/ and -s $INSTALLED_CONFIG_FNAME) {
# NOTE: be careful -- don't change __KOHA_CONF_DIR in the above
# regex to anything else -- don't want installer to rewrite it
$conf_fname = $INSTALLED_CONFIG_FNAME;
- } elsif (-e CONFIG_FNAME and -s CONFIG_FNAME) {
+ } elsif (-s CONFIG_FNAME) {
$conf_fname = CONFIG_FNAME;
} else {
warn "unable to locate Koha configuration file koha-conf.xml";
$self->{"marcfromkohafield"} = undef; # the hash with relations between koha table fields and MARC field/subfield
$self->{"userenv"} = undef; # User env
$self->{"activeuser"} = undef; # current active user
+ $self->{"shelves"} = undef;
bless $self, $class;
return $self;
my $auth=shift;
my $piggyback=shift;
my $syntax=shift;
- if ( defined($context->{"Zconn"}->{$server}) ) {
+ if ( defined($context->{"Zconn"}->{$server}) && (0 == $context->{"Zconn"}->{$server}->errcode()) ) {
return $context->{"Zconn"}->{$server};
# No connection object or it died. Create one.
}else {
+ # release resources if we're closing a connection and making a new one
+ # FIXME: this needs to be smarter -- an error due to a malformed query or
+ # a missing index does not necessarily require us to close the connection
+ # and make a new one, particularly for a batch job. However, at
+ # first glance it does not look like there's a way to easily check
+ # the basic health of a ZOOM::Connection
+ $context->{"Zconn"}->{$server}->destroy() if defined($context->{"Zconn"}->{$server});
+
$context->{"Zconn"}->{$server} = &_new_Zconn($server,$async,$auth,$piggyback,$syntax);
return $context->{"Zconn"}->{$server};
}
$db_port = "" unless defined $db_port;
my $db_user = $context->config("user");
my $db_passwd = $context->config("pass");
+ # MJR added or die here, as we can't work without dbh
my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
- $db_user, $db_passwd);
+ $db_user, $db_passwd) or die $DBI::errstr;
if ( $db_driver eq 'mysql' ) {
# Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
# this is better than modifying my.cnf (and forcing all communications to be in utf8)
- $dbh->do("set NAMES 'utf8'") if ($dbh);
$dbh->{'mysql_enable_utf8'}=1; #enable
+ $dbh->do("set NAMES 'utf8'");
}
elsif ( $db_driver eq 'Pg' ) {
$dbh->do( "set client_encoding = 'UTF8';" );
return $cell;
}
+sub set_shelves_userenv ($) {
+ my $lists = shift or return undef;
+ my $activeuser = $context->{activeuser} or return undef;
+ $context->{userenv}->{$activeuser}->{shelves} = $lists;
+ # die "set_shelves_userenv: $lists";
+}
+sub get_shelves_userenv () {
+ my $active;
+ unless ($active = $context->{userenv}->{$context->{activeuser}}) {
+ warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
+ return undef;
+ }
+ my $lists = $active->{shelves} or return undef;# die "get_shelves_userenv: activeenv has no ->{shelves}";
+ return $lists;
+}
+
=item _new_userenv
C4::Context->_new_userenv($session);
# A little example sub to show more debugging info for CGI::Carp
sub get_versions {
my %versions;
- $versions{kohaVersion} = C4::Context->config("kohaversion");
+ $versions{kohaVersion} = KOHAVERSION();
+ $versions{kohaDbVersion} = C4::Context->preference('version');
$versions{osVersion} = `uname -a`;
$versions{perlVersion} = $];
$versions{mysqlVersion} = `mysql -V`;
projects / koha.git / blobdiff