# 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) {
no warnings 'redefine';
*CGI::multi_param = \&CGI::param;
} # else there is no browser to send fatals to!
}
-use Encode;
-use ZOOM;
-use Koha::Caches;
-use POSIX ();
+use Carp;
use DateTime::TimeZone;
+use Encode;
+use File::Spec;
use Module::Load::Conditional qw(can_load);
-use Carp;
+use POSIX ();
+use YAML qw/Load/;
+use ZOOM;
use C4::Boolean;
use C4::Debug;
-use Koha;
-use Koha::Config;
+use Koha::Caches;
use Koha::Config::SysPref;
use Koha::Config::SysPrefs;
+use Koha::Config;
+use Koha;
=head1 NAME
}
my $conf_cache = Koha::Caches->get_instance('config');
- my $config_from_cache;
if ( $conf_cache->cache ) {
$self = $conf_cache->get_from_cache('koha_conf');
}
sub zebraconfig {
return _common_config($_[1],'server');
}
-sub ModZebrations {
- return _common_config($_[1],'serverinfo');
-}
=head2 preference
return defined($it)? C4::Boolean::true_p($it): undef;
}
+=head2 yaml_preference
+
+Retrieves the required system preference value, and converts it
+from YAML into a Perl data structure. It throws an exception if
+the value cannot be properly decoded as YAML.
+
+=cut
+
+sub yaml_preference {
+ my ( $self, $preference ) = @_;
+
+ my $yaml = eval { YAML::Load( $self->preference( $preference ) ); };
+ if ($@) {
+ warn "Unable to parse $preference syspref : $@";
+ return;
+ }
+
+ return $yaml;
+}
+
=head2 enable_syspref_cache
C4::Context->enable_syspref_cache();
sub set_preference {
my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
+ my $variable_case = $variable;
$variable = lc $variable;
my $syspref = Koha::Config::SysPrefs->find($variable);
)->store;
} else {
$syspref = Koha::Config::SysPref->new(
- { variable => $variable,
+ { variable => $variable_case,
value => $value,
explanation => $explanation || undef,
type => $type,
my $tried=0; # first attempt
my $Zconn; # connection object
my $elementSetName;
- my $index_mode;
my $syntax;
$server //= "biblioserver";
- if ( $server eq 'biblioserver' ) {
- $index_mode = $context->{'config'}->{'zebra_bib_index_mode'} // 'dom';
- } elsif ( $server eq 'authorityserver' ) {
- $index_mode = $context->{'config'}->{'zebra_auth_index_mode'} // 'dom';
- }
-
- if ( $index_mode eq 'grs1' ) {
- $elementSetName = 'F';
- $syntax = ( $context->preference("marcflavour") eq 'UNIMARC' )
- ? 'unimarc'
- : 'usmarc';
-
- } else { # $index_mode eq 'dom'
- $syntax = 'xml';
- $elementSetName = 'marcxml';
- }
+ $syntax = 'xml';
+ $elementSetName = 'marcxml';
my $host = $context->{'listen'}->{$server}->{'content'};
my $user = $context->{"serverinfo"}->{$server}->{"user"};
{
my $self = shift;
my $params = shift;
- my $sth;
unless ( $params->{new} ) {
return Koha::Database->schema->storage->dbh;
# return something, then this function should, too.
}
-=head2 queryparser
-
- $queryparser = C4::Context->queryparser
-
-Returns a handle to an initialized Koha::QueryParser::Driver::PQF object.
-
-=cut
-
-sub queryparser {
- my $self = shift;
- unless (defined $context->{"queryparser"}) {
- $context->{"queryparser"} = &_new_queryparser();
- }
-
- return
- defined( $context->{"queryparser"} )
- ? $context->{"queryparser"}->new
- : undef;
-}
-
-=head2 _new_queryparser
-
-Internal helper function to create a new QueryParser object. QueryParser
-is loaded dynamically so as to keep the lack of the QueryParser library from
-getting in anyone's way.
-
-=cut
-
-sub _new_queryparser {
- my $qpmodules = {
- 'OpenILS::QueryParser' => undef,
- 'Koha::QueryParser::Driver::PQF' => undef
- };
- if ( can_load( 'modules' => $qpmodules ) ) {
- my $QParser = Koha::QueryParser::Driver::PQF->new();
- my $config_file = $context->config('queryparser_config');
- $config_file ||= '/etc/koha/searchengine/queryparser.yaml';
- if ( $QParser->load_config($config_file) ) {
- # Set 'keyword' as the default search class
- $QParser->default_search_class('keyword');
- # TODO: allow indexes to be configured in the database
- return $QParser;
- }
- }
- return;
-}
-
=head2 userenv
C4::Context->userenv;
C4::Context->set_userenv($usernum, $userid, $usercnum,
$userfirstname, $usersurname,
$userbranch, $branchname, $userflags,
- $emailaddress, $branchprinter, $persona);
+ $emailaddress, $shibboleth
+ $desk_id, $desk_name);
Establish a hash of user environment variables.
#'
sub set_userenv {
shift @_;
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $persona, $shibboleth)=
+ 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 $var=$context->{"activeuser"} || '';
#possibly a law problem
"branch" => $userbranch,
"branchname" => $branchname,
+ "desk_id" => $desk_id,
+ "desk_name" => $desk_name,
"flags" => $userflags,
"emailaddress" => $emailaddress,
- "branchprinter" => $branchprinter,
- "persona" => $persona,
"shibboleth" => $shibboleth,
};
$context->{userenv}->{$var} = $cell;
return %versions;
}
+=head2 timezone
+
+ my $C4::Context->timzone
+
+ Returns a timezone code for the instance of Koha
+
+=cut
+
+sub timezone {
+ my $self = shift;
+
+ my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
+ if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
+ warn "Invalid timezone in koha-conf.xml ($timezone)";
+ $timezone = 'local';
+ }
+
+ return $timezone;
+}
=head2 tz
sub tz {
my $self = shift;
if (!defined $context->{tz}) {
- $context->{tz} = DateTime::TimeZone->new(name => 'local');
+ my $timezone = $self->timezone;
+ $context->{tz} = DateTime::TimeZone->new(name => $timezone);
}
return $context->{tz};
}
if (defined $interface) {
$interface = lc $interface;
- if ($interface eq 'opac' || $interface eq 'intranet' || $interface eq 'sip' || $interface eq 'commandline') {
+ if ( $interface eq 'api'
+ || $interface eq 'opac'
+ || $interface eq 'intranet'
+ || $interface eq 'sip'
+ || $interface eq 'cron'
+ || $interface eq 'commandline' )
+ {
$context->{interface} = $interface;
} else {
warn "invalid interface : '$interface'";
&& C4::Context->userenv->{branch};
}
+=head3 temporary_directory
+
+Returns root directory for temporary storage
+
+=cut
+
+sub temporary_directory {
+ my ( $class ) = @_;
+ return C4::Context->config('tmp_path') || File::Spec->tmpdir;
+}
+
+=head3 set_remote_address
+
+set_remote_address should be called at the beginning of every script
+that is *not* running under plack in order to the REMOTE_ADDR environment
+variable to be set correctly.
+
+=cut
+
+sub set_remote_address {
+ if ( C4::Context->config('koha_trusted_proxies') ) {
+ require CGI;
+ my $header = CGI->http('HTTP_X_FORWARDED_FOR');
+
+ if ($header) {
+ require Koha::Middleware::RealIP;
+ $ENV{REMOTE_ADDR} = Koha::Middleware::RealIP::get_real_ip( $ENV{REMOTE_ADDR}, $header );
+ }
+ }
+}
+
+=head3 https_enabled
+
+https_enabled should be called when checking if a HTTPS connection
+is used.
+
+Note that this depends on a HTTPS environmental variable being defined
+by the web server. This function may not return the expected result,
+if your web server or reverse proxies are not setting the correct
+X-Forwarded-Proto headers and HTTPS environmental variable.
+
+Note too that the HTTPS value can vary from web server to web server.
+We are relying on the convention of the value being "on" or "ON" here.
+
+=cut
+
+sub https_enabled {
+ my $https_enabled = 0;
+ my $env_https = $ENV{HTTPS};
+ if ($env_https){
+ if ($env_https =~ /^ON$/i){
+ $https_enabled = 1;
+ }
+ }
+ return $https_enabled;
+}
+
1;
+=head3 needs_install
+
+ if ( $context->needs_install ) { ... }
+
+This method returns a boolean representing the install status of the Koha instance.
+
+=cut
+
+sub needs_install {
+ my ($self) = @_;
+ return ($self->preference('Version')) ? 0 : 1;
+}
+
__END__
=head1 ENVIRONMENT