use vars qw($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;
- eval {C4::Context->dbh();};
- if ($@){
- $debug_level = 1;
- }
- else {
- $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>Koha error</h1>
- <p>The following fatal error has occurred:</p>
- <pre><code>$msg</code></pre>
- <table>
- <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>Koha error</h1>
- <p>The following fatal error has occurred:</p>
- <pre><code>$msg</code></pre>";
- } else {
- print "<p>production mode - trapped fatal error</p>";
- }
- 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;
- }
+ if ( $ENV{'HTTP_USER_AGENT'} ) { # Only hit when plack is not enabled
# Redefine multi_param if cgi version is < 4.08
# Remove the "CGI::param called in list context" warning in this case
- require CGI; # Can't check version without the require.
- if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
+ require CGI; # Can't check version without the require.
+ if ( !defined($CGI::VERSION) || $CGI::VERSION < 4.08 ) {
no warnings 'redefine';
*CGI::multi_param = \&CGI::param;
use warnings 'redefine';
$CGI::LIST_CONTEXT_WARN = 0;
}
- } # else there is no browser to send fatals to!
-}
+ }
+};
use Carp;
use DateTime::TimeZone;
use File::Spec;
use Module::Load::Conditional qw(can_load);
use POSIX ();
-use YAML qw/Load/;
+use YAML::XS;
use ZOOM;
-use C4::Boolean;
use C4::Debug;
use Koha::Caches;
use Koha::Config::SysPref;
=head2 new
- $context = new C4::Context;
- $context = new C4::Context("/path/to/koha-conf.xml");
+ $context = C4::Context->new;
+ $context = C4::Context->new("/path/to/koha-conf.xml");
Allocates a new context. Initializes the context from the specified
file, which defaults to either the file given by the C<$KOHA_CONF>
sub new {
my $class = shift;
my $conf_fname = shift; # Config file to load
- my $self = {};
# check that the specified config file exists and is not empty
undef $conf_fname unless
}
}
- my $conf_cache = Koha::Caches->get_instance('config');
- if ( $conf_cache->cache ) {
- $self = $conf_cache->get_from_cache('koha_conf');
- }
- unless ( $self and %$self ) {
- $self = Koha::Config->read_from_file($conf_fname);
- if ( $conf_cache->memcached_cache ) {
- # FIXME it may be better to use the memcached servers from the config file
- # to cache it
- $conf_cache->set_in_cache('koha_conf', $self)
- }
- }
+ my $self = Koha::Config->read_from_file($conf_fname);
unless ( exists $self->{config} or defined $self->{config} ) {
warn "The config file ($conf_fname) has not been parsed correctly";
return;
sub _common_config {
my $var = shift;
my $term = shift;
- return if !defined($context->{$term});
+ return unless defined $context and defined $context->{$term};
# Presumably $self->{$term} might be
# undefined if the config file given to &new
# didn't exist, and the caller didn't bother
=cut
-my $syspref_cache = Koha::Caches->get_instance('syspref');
my $use_syspref_cache = 1;
sub preference {
my $self = shift;
my $var = shift; # The system preference to return
- return $ENV{"OVERRIDE_SYSPREF_$var"}
+ return Encode::decode_utf8($ENV{"OVERRIDE_SYSPREF_$var"})
if defined $ENV{"OVERRIDE_SYSPREF_$var"};
$var = lc $var;
if ($use_syspref_cache) {
- $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache;
+ my $syspref_cache = Koha::Caches->get_instance('syspref');
my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
return $cached_var if defined $cached_var;
}
my $value = $syspref ? $syspref->value() : undef;
if ( $use_syspref_cache ) {
+ my $syspref_cache = Koha::Caches->get_instance('syspref');
$syspref_cache->set_in_cache("syspref_$var", $value);
}
return $value;
}
-sub boolean_preference {
- my $self = shift;
- my $var = shift; # The system preference to return
- my $it = preference($self, $var);
- return defined($it)? C4::Boolean::true_p($it): undef;
-}
-
=head2 yaml_preference
Retrieves the required system preference value, and converts it
sub yaml_preference {
my ( $self, $preference ) = @_;
- my $yaml = eval { YAML::Load( $self->preference( $preference ) ); };
+ my $yaml = eval { YAML::XS::Load( Encode::encode_utf8( $self->preference( $preference ) ) ); };
if ($@) {
warn "Unable to parse $preference syspref : $@";
return;
sub clear_syspref_cache {
return unless $use_syspref_cache;
+ my $syspref_cache = Koha::Caches->get_instance('syspref');
$syspref_cache->flush_all;
}
}
if ( $use_syspref_cache ) {
+ my $syspref_cache = Koha::Caches->get_instance('syspref');
$syspref_cache->set_in_cache( "syspref_$variable", $value );
}
if ( Koha::Config::SysPrefs->find( $var )->delete ) {
if ( $use_syspref_cache ) {
+ my $syspref_cache = Koha::Caches->get_instance('syspref');
$syspref_cache->clear_from_cache("syspref_$var");
}
$userfirstname, $usersurname,
$userbranch, $branchname, $userflags,
$emailaddress, $shibboleth
- $desk_id, $desk_name);
+ $desk_id, $desk_name,
+ $register_id, $register_name);
Establish a hash of user environment variables.
#'
sub set_userenv {
shift @_;
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $shibboleth, $desk_id, $desk_name)=
- map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
- @_;
+ my (
+ $usernum, $userid, $usercnum, $userfirstname,
+ $usersurname, $userbranch, $branchname, $userflags,
+ $emailaddress, $shibboleth, $desk_id, $desk_name,
+ $register_id, $register_name
+ ) = @_;
+
my $var=$context->{"activeuser"} || '';
my $cell = {
"number" => $usernum,
"cardnumber" => $usercnum,
"firstname" => $userfirstname,
"surname" => $usersurname,
+
#possibly a law problem
- "branch" => $userbranch,
- "branchname" => $branchname,
- "desk_id" => $desk_id,
- "desk_name" => $desk_name,
- "flags" => $userflags,
- "emailaddress" => $emailaddress,
- "shibboleth" => $shibboleth,
+ "branch" => $userbranch,
+ "branchname" => $branchname,
+ "flags" => $userflags,
+ "emailaddress" => $emailaddress,
+ "shibboleth" => $shibboleth,
+ "desk_id" => $desk_id,
+ "desk_name" => $desk_name,
+ "register_id" => $register_id,
+ "register_name" => $register_name
};
$context->{userenv}->{$var} = $cell;
return $cell;
Specifies the configuration file to read.
-=head1 SEE ALSO
-
-XML::Simple
-
=head1 AUTHORS
Andrew Arensburger <arensb at ooblick dot com>
projects / koha-ffzg.git / blobdiff