X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FContext.pm;h=a50ddfda5a1c205154784f5eb1c6638d9ca8bc44;hb=a471ad80bb70ed790cf7f544a45cdd3e61672ff4;hp=5b27e283f7f67b1c75fd6b3a65c717059a31f17e;hpb=9820f9dfbd63ecc812b6b2a4ec71af91f303f933;p=koha.git diff --git a/C4/Context.pm b/C4/Context.pm index 5b27e283f7..a50ddfda5a 100644 --- a/C4/Context.pm +++ b/C4/Context.pm @@ -1,4 +1,5 @@ package C4::Context; + # Copyright 2002 Katipo Communications # # This file is part of Koha. @@ -16,9 +17,9 @@ package C4::Context; # You should have received a copy of the GNU General Public License # along with Koha; if not, see . -use strict; -use warnings; -use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached); +use Modern::Perl; + +use vars qw($AUTOLOAD $context @context_stack); BEGIN { if ($ENV{'HTTP_USER_AGENT'}) { require CGI::Carp; @@ -76,31 +77,21 @@ BEGIN { if ($ENV{KOHA_BACKTRACES}) { $main::SIG{__DIE__} = \&CGI::Carp::confess; } - } # else there is no browser to send fatals to! - # Check if there are memcached servers set - $servers = $ENV{'MEMCACHED_SERVERS'}; - if ($servers) { - # Load required libraries and create the memcached object - require Cache::Memcached; - $memcached = Cache::Memcached->new({ - servers => [ $servers ], - debug => 0, - compress_threshold => 10_000, - expire_time => 600, - namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha' - }); - # Verify memcached available (set a variable and test the output) - $ismemcached = $memcached->set('ismemcached','1'); - } - - $VERSION = '3.07.00.049'; + # Redefine multi_param if cgi version is < 4.08 + # Remove the "CGI::param called in list context" warning in this case + 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 Encode; use ZOOM; -use XML::Simple; -use Koha::Cache; +use Koha::Caches; use POSIX (); use DateTime::TimeZone; use Module::Load::Conditional qw(can_load); @@ -109,6 +100,7 @@ use Carp; use C4::Boolean; use C4::Debug; use Koha; +use Koha::Config; use Koha::Config::SysPref; use Koha::Config::SysPrefs; @@ -177,95 +169,9 @@ environment variable to the pathname of a configuration file to use. # Zconn # A connection object for the Zebra server -# Koha's main configuration file koha-conf.xml -# is searched for according to this priority list: -# -# 1. Path supplied via use C4::Context '/path/to/koha-conf.xml' -# 2. Path supplied in KOHA_CONF environment variable. -# 3. Path supplied in INSTALLED_CONFIG_FNAME, as long -# as value has changed from its default of -# '__KOHA_CONF_DIR__/koha-conf.xml', as happens -# when Koha is installed in 'standard' or 'single' -# mode. -# 4. Path supplied in CONFIG_FNAME. -# -# The first entry that refers to a readable file is used. - -use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml"; - # Default config file, if none is specified - -my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml'; - # path to config file set by installer - # __KOHA_CONF_DIR__ is set by rewrite-confg.PL - # when Koha is installed in 'standard' or 'single' - # mode. If Koha was installed in 'dev' mode, - # __KOHA_CONF_DIR__ is *not* rewritten; instead - # developers should set the KOHA_CONF environment variable - $context = undef; # Initially, no context is set @context_stack = (); # Initially, no saved contexts - -=head2 read_config_file - -Reads the specified Koha config file. - -Returns an object containing the configuration variables. The object's -structure is a bit complex to the uninitiated ... take a look at the -koha-conf.xml file as well as the XML::Simple documentation for details. Or, -here are a few examples that may give you what you need: - -The simple elements nested within the element: - - my $pass = $koha->{'config'}->{'pass'}; - -The elements: - - my $listen = $koha->{'listen'}->{'biblioserver'}->{'content'}; - -The elements nested within the element: - - my $ccl2rpn = $koha->{'server'}->{'biblioserver'}->{'cql2rpn'}; - -Returns undef in case of error. - -=cut - -sub read_config_file { # Pass argument naming config file to read - my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => ''); - - if ($ismemcached) { - $memcached->set('kohaconf',$koha); - } - - return $koha; # Return value: ref-to-hash holding the configuration -} - -=head2 ismemcached - -Returns the value of the $ismemcached variable (0/1) - -=cut - -sub ismemcached { - return $ismemcached; -} - -=head2 memcached - -If $ismemcached is true, returns the $memcache variable. -Returns undef otherwise - -=cut - -sub memcached { - if ($ismemcached) { - return $memcached; - } else { - return; - } -} - =head2 db_scheme2dbi my $dbd_driver_name = C4::Context::db_schema2dbi($scheme); @@ -330,42 +236,33 @@ sub new { undef $conf_fname unless (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 -s $ENV{"KOHA_CONF"}) { - $conf_fname = $ENV{"KOHA_CONF"}; - } 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 (-s CONFIG_FNAME) { - $conf_fname = CONFIG_FNAME; - } else { + unless ( defined $conf_fname ) { + $conf_fname = Koha::Config->guess_koha_conf; + unless ( $conf_fname ) { warn "unable to locate Koha configuration file koha-conf.xml"; return; } } - - if ($ismemcached) { - # retrieve from memcached - $self = $memcached->get('kohaconf'); - if (not defined $self) { - # not in memcached yet - $self = read_config_file($conf_fname); + + my $conf_cache = Koha::Caches->get_instance('config'); + my $config_from_cache; + 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) } - } else { - # non-memcached env, read from file - $self = read_config_file($conf_fname); } - - $self->{"config_file"} = $conf_fname; - warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"}); - return if !defined($self->{"config"}); + unless ( exists $self->{config} or defined $self->{config} ) { + warn "The config file ($conf_fname) has not been parsed correctly"; + return; + } $self->{"Zconn"} = undef; # Zebra Connections - $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; @@ -504,31 +401,30 @@ with this method. =cut -my $syspref_cache = Koha::Cache->get_instance(); +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"} + if defined $ENV{"OVERRIDE_SYSPREF_$var"}; + $var = lc $var; - my $cached_var = $use_syspref_cache - ? $syspref_cache->get_from_cache("syspref_$var") - : undef; - return $cached_var if defined $cached_var; + if ($use_syspref_cache) { + $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache; + my $cached_var = $syspref_cache->get_from_cache("syspref_$var"); + return $cached_var if defined $cached_var; + } - my $dbh = C4::Context->dbh or return 0; + my $syspref; + eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; + my $value = $syspref ? $syspref->value() : undef; - my $value; - if ( defined $ENV{"OVERRIDE_SYSPREF_$var"} ) { - $value = $ENV{"OVERRIDE_SYSPREF_$var"}; - } else { - my $syspref; - eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) }; - $value = $syspref ? $syspref->value() : undef; + if ( $use_syspref_cache ) { + $syspref_cache->set_in_cache("syspref_$var", $value); } - - $syspref_cache->set_in_cache("syspref_$var", $value) if $use_syspref_cache; return $value; } @@ -581,7 +477,8 @@ will not be seen by this process. =cut sub clear_syspref_cache { - $syspref_cache->flush_all if $use_syspref_cache; + return unless $use_syspref_cache; + $syspref_cache->flush_all; } =head2 set_preference @@ -606,8 +503,10 @@ sub set_preference { : $syspref ? $syspref->type : undef; + $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' ); + # force explicit protocol on OPACBaseURL - if ( $variable eq 'opacbaseurl' && substr( $value, 0, 4 ) !~ /http/ ) { + if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) { $value = 'http://' . $value; } @@ -630,8 +529,9 @@ sub set_preference { )->store(); } - $syspref_cache->set_in_cache( "syspref_$variable", $value ) - if $use_syspref_cache; + if ( $use_syspref_cache ) { + $syspref_cache->set_in_cache( "syspref_$variable", $value ); + } return $syspref; } @@ -650,7 +550,10 @@ sub delete_preference { my ( $self, $var ) = @_; if ( Koha::Config::SysPrefs->find( $var )->delete ) { - $syspref_cache->clear_from_cache("syspref_$var") if $use_syspref_cache; + if ( $use_syspref_cache ) { + $syspref_cache->clear_from_cache("syspref_$var"); + } + return 1; } return 0; @@ -918,45 +821,6 @@ sub _new_queryparser { return; } -=head2 marcfromkohafield - - $dbh = C4::Context->marcfromkohafield; - -Returns a hash with marcfromkohafield. - -This hash is cached for future use: if you call -Cmarcfromkohafield> twice, you will get the same hash without real DB access - -=cut - -#' -sub marcfromkohafield -{ - my $retval = {}; - - # If the hash already exists, return it. - return $context->{"marcfromkohafield"} if defined($context->{"marcfromkohafield"}); - - # No hash. Create one. - $context->{"marcfromkohafield"} = &_new_marcfromkohafield(); - - return $context->{"marcfromkohafield"}; -} - -# _new_marcfromkohafield -sub _new_marcfromkohafield -{ - my $dbh = C4::Context->dbh; - my $marcfromkohafield; - my $sth = $dbh->prepare("select frameworkcode,kohafield,tagfield,tagsubfield from marc_subfield_structure where kohafield > ''"); - $sth->execute; - while (my ($frameworkcode,$kohafield,$tagfield,$tagsubfield) = $sth->fetchrow) { - my $retval = {}; - $marcfromkohafield->{$frameworkcode}->{$kohafield} = [$tagfield,$tagsubfield]; - } - return $marcfromkohafield; -} - =head2 userenv C4::Context->userenv; @@ -983,7 +847,7 @@ sub userenv { C4::Context->set_userenv($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, - $emailaddress, $branchprinter, $persona); + $emailaddress, $branchprinter, $shibboleth); Establish a hash of user environment variables. @@ -994,7 +858,7 @@ set_userenv is called in Auth.pm #' 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, $branchprinter, $shibboleth)= map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here @_; my $var=$context->{"activeuser"} || ''; @@ -1010,7 +874,6 @@ sub set_userenv { "flags" => $userflags, "emailaddress" => $emailaddress, "branchprinter" => $branchprinter, - "persona" => $persona, "shibboleth" => $shibboleth, }; $context->{userenv}->{$var} = $cell; @@ -1167,7 +1030,31 @@ sub interface { return $context->{interface} // 'opac'; } +# always returns a string for OK comparison via "eq" or "ne" +sub mybranch { + C4::Context->userenv or return ''; + return C4::Context->userenv->{branch} || ''; +} + +=head2 only_my_library + + my $test = C4::Context->only_my_library; + + Returns true if you enabled IndependentBranches and the current user + does not have superlibrarian permissions. + +=cut + +sub only_my_library { + return + C4::Context->preference('IndependentBranches') + && C4::Context->userenv + && !C4::Context->IsSuperLibrarian() + && C4::Context->userenv->{branch}; +} + 1; + __END__ =head1 ENVIRONMENT