3 # Copyright 2002 Katipo Communications
5 # This file is part of Koha.
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
22 use vars qw($AUTOLOAD $context @context_stack);
24 if ($ENV{'HTTP_USER_AGENT'}) {
26 # FIXME for future reference, CGI::Carp doc says
27 # "Note that fatalsToBrowser does not work with mod_perl version 2.0 and higher."
28 import CGI::Carp qw(fatalsToBrowser);
32 eval {C4::Context->dbh();};
37 $debug_level = C4::Context->preference("DebugLevel");
40 print q(<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
41 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
42 <html lang="en" xml:lang="en" xmlns="http://www.w3.org/1999/xhtml">
43 <head><title>Koha Error</title></head>
46 if ($debug_level eq "2"){
47 # debug 2 , print extra info too.
48 my %versions = get_versions();
50 # a little example table with various version info";
53 <p>The following fatal error has occurred:</p>
54 <pre><code>$msg</code></pre>
56 <tr><th>Apache</th><td> $versions{apacheVersion}</td></tr>
57 <tr><th>Koha</th><td> $versions{kohaVersion}</td></tr>
58 <tr><th>Koha DB</th><td> $versions{kohaDbVersion}</td></tr>
59 <tr><th>MySQL</th><td> $versions{mysqlVersion}</td></tr>
60 <tr><th>OS</th><td> $versions{osVersion}</td></tr>
61 <tr><th>Perl</th><td> $versions{perlVersion}</td></tr>
64 } elsif ($debug_level eq "1"){
67 <p>The following fatal error has occurred:</p>
68 <pre><code>$msg</code></pre>";
70 print "<p>production mode - trapped fatal error</p>";
72 print "</body></html>";
74 #CGI::Carp::set_message(\&handle_errors);
75 ## give a stack backtrace if KOHA_BACKTRACES is set
76 ## can't rely on DebugLevel for this, as we're not yet connected
77 if ($ENV{KOHA_BACKTRACES}) {
78 $main::SIG{__DIE__} = \&CGI::Carp::confess;
81 # Redefine multi_param if cgi version is < 4.08
82 # Remove the "CGI::param called in list context" warning in this case
83 require CGI; # Can't check version without the require.
84 if (!defined($CGI::VERSION) || $CGI::VERSION < 4.08) {
85 no warnings 'redefine';
86 *CGI::multi_param = \&CGI::param;
87 use warnings 'redefine';
88 $CGI::LIST_CONTEXT_WARN = 0;
90 } # else there is no browser to send fatals to!
94 use DateTime::TimeZone;
97 use Module::Load::Conditional qw(can_load);
104 use Koha::Config::SysPref;
105 use Koha::Config::SysPrefs;
111 C4::Context - Maintain and manipulate the context of a Koha script
117 use C4::Context("/path/to/koha-conf.xml");
119 $config_value = C4::Context->config("config_variable");
121 $koha_preference = C4::Context->preference("preference");
123 $db_handle = C4::Context->dbh;
125 $Zconn = C4::Context->Zconn;
129 When a Koha script runs, it makes use of a certain number of things:
130 configuration settings in F</etc/koha/koha-conf.xml>, a connection to the Koha
131 databases, and so forth. These things make up the I<context> in which
134 This module takes care of setting up the context for a script:
135 figuring out which configuration file to load, and loading it, opening
136 a connection to the right database, and so forth.
138 Most scripts will only use one context. They can simply have
144 Other scripts may need to use several contexts. For instance, if a
145 library has two databases, one for a certain collection, and the other
146 for everything else, it might be necessary for a script to use two
147 different contexts to search both databases. Such scripts should use
148 the C<&set_context> and C<&restore_context> functions, below.
150 By default, C4::Context reads the configuration from
151 F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
152 environment variable to the pathname of a configuration file to use.
159 # In addition to what is said in the POD above, a Context object is a
160 # reference-to-hash with the following fields:
163 # A reference-to-hash whose keys and values are the
164 # configuration variables and values specified in the config
165 # file (/etc/koha/koha-conf.xml).
167 # A handle to the appropriate database for this context.
169 # Used by &set_dbh and &restore_dbh to hold other database
170 # handles for this context.
172 # A connection object for the Zebra server
174 $context = undef; # Initially, no context is set
175 @context_stack = (); # Initially, no saved contexts
179 my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
181 This routines translates a database type to part of the name
182 of the appropriate DBD driver to use when establishing a new
183 database connection. It recognizes 'mysql' and 'Pg'; if any
184 other scheme is supplied it defaults to 'mysql'.
189 my $scheme = shift // '';
190 return $scheme eq 'Pg' ? $scheme : 'mysql';
194 # Create the default context ($C4::Context::Context)
195 # the first time the module is called
196 # (a config file can be optionaly passed)
198 # default context already exists?
202 my ($pkg,$config_file) = @_ ;
203 my $new_ctx = __PACKAGE__->new($config_file);
204 return unless $new_ctx;
206 # if successfully loaded, use it by default
207 $new_ctx->set_context;
213 $context = C4::Context->new;
214 $context = C4::Context->new("/path/to/koha-conf.xml");
216 Allocates a new context. Initializes the context from the specified
217 file, which defaults to either the file given by the C<$KOHA_CONF>
218 environment variable, or F</etc/koha/koha-conf.xml>.
220 It saves the koha-conf.xml values in the declared memcached server(s)
221 if currently available and uses those values until them expire and
224 C<&new> does not set this context as the new default context; for
225 that, use C<&set_context>.
231 # 2004-08-10 A. Tarallo: Added check if the conf file is not empty
234 my $conf_fname = shift; # Config file to load
237 # check that the specified config file exists and is not empty
238 undef $conf_fname unless
239 (defined $conf_fname && -s $conf_fname);
240 # Figure out a good config file to load if none was specified.
241 unless ( defined $conf_fname ) {
242 $conf_fname = Koha::Config->guess_koha_conf;
243 unless ( $conf_fname ) {
244 warn "unable to locate Koha configuration file koha-conf.xml";
249 my $conf_cache = Koha::Caches->get_instance('config');
250 if ( $conf_cache->cache ) {
251 $self = $conf_cache->get_from_cache('koha_conf');
253 unless ( $self and %$self ) {
254 $self = Koha::Config->read_from_file($conf_fname);
255 if ( $conf_cache->memcached_cache ) {
256 # FIXME it may be better to use the memcached servers from the config file
258 $conf_cache->set_in_cache('koha_conf', $self)
261 unless ( exists $self->{config} or defined $self->{config} ) {
262 warn "The config file ($conf_fname) has not been parsed correctly";
266 $self->{"Zconn"} = undef; # Zebra Connections
267 $self->{"userenv"} = undef; # User env
268 $self->{"activeuser"} = undef; # current active user
269 $self->{"shelves"} = undef;
270 $self->{tz} = undef; # local timezone object
273 $self->{db_driver} = db_scheme2dbi($self->config('db_scheme')); # cache database driver
279 $context = new C4::Context;
280 $context->set_context();
282 set_context C4::Context $context;
285 restore_context C4::Context;
287 In some cases, it might be necessary for a script to use multiple
288 contexts. C<&set_context> saves the current context on a stack, then
289 sets the context to C<$context>, which will be used in future
290 operations. To restore the previous context, use C<&restore_context>.
298 my $new_context; # The context to set
300 # Figure out whether this is a class or instance method call.
302 # We're going to make the assumption that control got here
303 # through valid means, i.e., that the caller used an instance
304 # or class method call, and that control got here through the
305 # usual inheritance mechanisms. The caller can, of course,
306 # break this assumption by playing silly buggers, but that's
307 # harder to do than doing it properly, and harder to check
309 if (ref($self) eq "")
311 # Class method. The new context is the next argument.
312 $new_context = shift;
314 # Instance method. The new context is $self.
315 $new_context = $self;
318 # Save the old context, if any, on the stack
319 push @context_stack, $context if defined($context);
321 # Set the new context
322 $context = $new_context;
325 =head2 restore_context
329 Restores the context set by C<&set_context>.
338 if ($#context_stack < 0)
341 die "Context stack underflow";
344 # Pop the old context and set it.
345 $context = pop @context_stack;
347 # FIXME - Should this return something, like maybe the context
348 # that was current when this was called?
353 $value = C4::Context->config("config_variable");
355 $value = C4::Context->config_variable;
357 Returns the value of a variable specified in the configuration file
358 from which the current context was created.
360 The second form is more compact, but of course may conflict with
361 method names. If there is a configuration variable called "new", then
362 C<C4::Config-E<gt>new> will not return it.
369 return if !defined($context->{$term});
370 # Presumably $self->{$term} might be
371 # undefined if the config file given to &new
372 # didn't exist, and the caller didn't bother
373 # to check the return value.
375 # Return the value of the requested config variable
376 return $context->{$term}->{$var};
380 return _common_config($_[1],'config');
383 return _common_config($_[1],'server');
388 $sys_preference = C4::Context->preference('some_variable');
390 Looks up the value of the given system preference in the
391 systempreferences table of the Koha database, and returns it. If the
392 variable is not set or does not exist, undef is returned.
394 In case of an error, this may return 0.
396 Note: It is impossible to tell the difference between system
397 preferences which do not exist, and those whose values are set to NULL
402 my $syspref_cache = Koha::Caches->get_instance('syspref');
403 my $use_syspref_cache = 1;
406 my $var = shift; # The system preference to return
408 return $ENV{"OVERRIDE_SYSPREF_$var"}
409 if defined $ENV{"OVERRIDE_SYSPREF_$var"};
413 if ($use_syspref_cache) {
414 $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache;
415 my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
416 return $cached_var if defined $cached_var;
420 eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
421 my $value = $syspref ? $syspref->value() : undef;
423 if ( $use_syspref_cache ) {
424 $syspref_cache->set_in_cache("syspref_$var", $value);
429 =head2 yaml_preference
431 Retrieves the required system preference value, and converts it
432 from YAML into a Perl data structure. It throws an exception if
433 the value cannot be properly decoded as YAML.
437 sub yaml_preference {
438 my ( $self, $preference ) = @_;
440 my $yaml = eval { YAML::XS::Load( Encode::encode_utf8( $self->preference( $preference ) ) ); };
442 warn "Unable to parse $preference syspref : $@";
449 =head2 enable_syspref_cache
451 C4::Context->enable_syspref_cache();
453 Enable the in-memory syspref cache used by C4::Context. This is the
458 sub enable_syspref_cache {
460 $use_syspref_cache = 1;
461 # We need to clear the cache to have it up-to-date
462 $self->clear_syspref_cache();
465 =head2 disable_syspref_cache
467 C4::Context->disable_syspref_cache();
469 Disable the in-memory syspref cache used by C4::Context. This should be
470 used with Plack and other persistent environments.
474 sub disable_syspref_cache {
476 $use_syspref_cache = 0;
477 $self->clear_syspref_cache();
480 =head2 clear_syspref_cache
482 C4::Context->clear_syspref_cache();
484 cleans the internal cache of sysprefs. Please call this method if
485 you update the systempreferences table. Otherwise, your new changes
486 will not be seen by this process.
490 sub clear_syspref_cache {
491 return unless $use_syspref_cache;
492 $syspref_cache->flush_all;
495 =head2 set_preference
497 C4::Context->set_preference( $variable, $value, [ $explanation, $type, $options ] );
499 This updates a preference's value both in the systempreferences table and in
500 the sysprefs cache. If the optional parameters are provided, then the query
501 becomes a create. It won't update the parameters (except value) for an existing
507 my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
509 my $variable_case = $variable;
510 $variable = lc $variable;
512 my $syspref = Koha::Config::SysPrefs->find($variable);
515 : $syspref ? $syspref->type
518 $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
520 # force explicit protocol on OPACBaseURL
521 if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) {
522 $value = 'http://' . $value;
527 { ( defined $value ? ( value => $value ) : () ),
528 ( $explanation ? ( explanation => $explanation ) : () ),
529 ( $type ? ( type => $type ) : () ),
530 ( $options ? ( options => $options ) : () ),
534 $syspref = Koha::Config::SysPref->new(
535 { variable => $variable_case,
537 explanation => $explanation || undef,
539 options => $options || undef,
544 if ( $use_syspref_cache ) {
545 $syspref_cache->set_in_cache( "syspref_$variable", $value );
551 =head2 delete_preference
553 C4::Context->delete_preference( $variable );
555 This deletes a system preference from the database. Returns a true value on
556 success. Failure means there was an issue with the database, not that there
557 was no syspref of the name.
561 sub delete_preference {
562 my ( $self, $var ) = @_;
564 if ( Koha::Config::SysPrefs->find( $var )->delete ) {
565 if ( $use_syspref_cache ) {
566 $syspref_cache->clear_from_cache("syspref_$var");
576 $Zconn = C4::Context->Zconn
578 Returns a connection to the Zebra database
582 C<$server> one of the servers defined in the koha-conf.xml file
584 C<$async> whether this is a asynchronous connection
589 my ($self, $server, $async ) = @_;
590 my $cache_key = join ('::', (map { $_ // '' } ($server, $async )));
591 if ( (!defined($ENV{GATEWAY_INTERFACE})) && defined($context->{"Zconn"}->{$cache_key}) && (0 == $context->{"Zconn"}->{$cache_key}->errcode()) ) {
592 # if we are running the script from the commandline, lets try to use the caching
593 return $context->{"Zconn"}->{$cache_key};
595 $context->{"Zconn"}->{$cache_key}->destroy() if defined($context->{"Zconn"}->{$cache_key}); #destroy old connection before making a new one
596 $context->{"Zconn"}->{$cache_key} = &_new_Zconn( $server, $async );
597 return $context->{"Zconn"}->{$cache_key};
602 $context->{"Zconn"} = &_new_Zconn($server,$async);
604 Internal function. Creates a new database connection from the data given in the current context and returns it.
606 C<$server> one of the servers defined in the koha-conf.xml file
608 C<$async> whether this is a asynchronous connection
610 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
615 my ( $server, $async ) = @_;
617 my $tried=0; # first attempt
618 my $Zconn; # connection object
622 $server //= "biblioserver";
625 $elementSetName = 'marcxml';
627 my $host = $context->{'listen'}->{$server}->{'content'};
628 my $user = $context->{"serverinfo"}->{$server}->{"user"};
629 my $password = $context->{"serverinfo"}->{$server}->{"password"};
632 my $o = ZOOM::Options->new();
633 $o->option(user => $user) if $user && $password;
634 $o->option(password => $password) if $user && $password;
635 $o->option(async => 1) if $async;
636 $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
637 $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
638 $o->option(preferredRecordSyntax => $syntax);
639 $o->option(elementSetName => $elementSetName) if $elementSetName;
640 $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
642 # create a new connection object
643 $Zconn= create ZOOM::Connection($o);
646 $Zconn->connect($host, 0);
648 # check for errors and warn
649 if ($Zconn->errcode() !=0) {
650 warn "something wrong with the connection: ". $Zconn->errmsg();
657 # Internal helper function (not a method!). This creates a new
658 # database connection from the data given in the current context, and
663 Koha::Database->schema({ new => 1 })->storage->dbh;
668 $dbh = C4::Context->dbh;
670 Returns a database handle connected to the Koha database for the
671 current context. If no connection has yet been made, this method
672 creates one, and connects to the database.
674 This database handle is cached for future use: if you call
675 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
676 times. If you need a second database handle, use C<&new_dbh> and
677 possibly C<&set_dbh>.
687 unless ( $params->{new} ) {
688 return Koha::Database->schema->storage->dbh;
691 return Koha::Database->schema({ new => 1 })->storage->dbh;
696 $dbh = C4::Context->new_dbh;
698 Creates a new connection to the Koha database for the current context,
699 and returns the database handle (a C<DBI::db> object).
701 The handle is not saved anywhere: this method is strictly a
702 convenience function; the point is that it knows which database to
703 connect to so that the caller doesn't have to know.
712 return &dbh({ new => 1 });
717 $my_dbh = C4::Connect->new_dbh;
718 C4::Connect->set_dbh($my_dbh);
720 C4::Connect->restore_dbh;
722 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
723 C<&set_context> and C<&restore_context>.
725 C<&set_dbh> saves the current database handle on a stack, then sets
726 the current database handle to C<$my_dbh>.
728 C<$my_dbh> is assumed to be a good database handle.
738 # Save the current database handle on the handle stack.
739 # We assume that $new_dbh is all good: if the caller wants to
740 # screw himself by passing an invalid handle, that's fine by
742 push @{$context->{"dbh_stack"}}, $context->{"dbh"};
743 $context->{"dbh"} = $new_dbh;
748 C4::Context->restore_dbh;
750 Restores the database handle saved by an earlier call to
751 C<C4::Context-E<gt>set_dbh>.
760 if ($#{$context->{"dbh_stack"}} < 0)
763 die "DBH stack underflow";
766 # Pop the old database handle and set it.
767 $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
769 # FIXME - If it is determined that restore_context should
770 # return something, then this function should, too.
775 C4::Context->userenv;
777 Retrieves a hash for user environment variables.
779 This hash shall be cached for future use: if you call
780 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
786 my $var = $context->{"activeuser"};
787 if (defined $var and defined $context->{"userenv"}->{$var}) {
788 return $context->{"userenv"}->{$var};
796 C4::Context->set_userenv($usernum, $userid, $usercnum,
797 $userfirstname, $usersurname,
798 $userbranch, $branchname, $userflags,
799 $emailaddress, $shibboleth
800 $desk_id, $desk_name,
801 $register_id, $register_name);
803 Establish a hash of user environment variables.
805 set_userenv is called in Auth.pm
812 my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $shibboleth, $desk_id, $desk_name, $register_id, $register_name)=
813 map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
815 my $var=$context->{"activeuser"} || '';
817 "number" => $usernum,
819 "cardnumber" => $usercnum,
820 "firstname" => $userfirstname,
821 "surname" => $usersurname,
823 #possibly a law problem
824 "branch" => $userbranch,
825 "branchname" => $branchname,
826 "flags" => $userflags,
827 "emailaddress" => $emailaddress,
828 "shibboleth" => $shibboleth,
829 "desk_id" => $desk_id,
830 "desk_name" => $desk_name,
831 "register_id" => $register_id,
832 "register_name" => $register_name
834 $context->{userenv}->{$var} = $cell;
838 sub set_shelves_userenv {
839 my ($type, $shelves) = @_ or return;
840 my $activeuser = $context->{activeuser} or return;
841 $context->{userenv}->{$activeuser}->{barshelves} = $shelves if $type eq 'bar';
842 $context->{userenv}->{$activeuser}->{pubshelves} = $shelves if $type eq 'pub';
843 $context->{userenv}->{$activeuser}->{totshelves} = $shelves if $type eq 'tot';
846 sub get_shelves_userenv {
848 unless ($active = $context->{userenv}->{$context->{activeuser}}) {
849 $debug and warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
852 my $totshelves = $active->{totshelves} or undef;
853 my $pubshelves = $active->{pubshelves} or undef;
854 my $barshelves = $active->{barshelves} or undef;
855 return ($totshelves, $pubshelves, $barshelves);
860 C4::Context->_new_userenv($session); # FIXME: This calling style is wrong for what looks like an _internal function
862 Builds a hash for user environment variables.
864 This hash shall be cached for future use: if you call
865 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
867 _new_userenv is called in Auth.pm
874 shift; # Useless except it compensates for bad calling style
876 $context->{"activeuser"}=$sessionID;
879 =head2 _unset_userenv
881 C4::Context->_unset_userenv;
883 Destroys the hash for activeuser user environment variables.
892 undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
898 C4::Context->get_versions
900 Gets various version info, for core Koha packages, Currently called from carp handle_errors() sub, to send to browser if 'DebugLevel' syspref is set to '2'.
906 # A little example sub to show more debugging info for CGI::Carp
909 $versions{kohaVersion} = Koha::version();
910 $versions{kohaDbVersion} = C4::Context->preference('version');
911 $versions{osVersion} = join(" ", POSIX::uname());
912 $versions{perlVersion} = $];
914 no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
915 $versions{mysqlVersion} = `mysql -V`;
916 $versions{apacheVersion} = (`apache2ctl -v`)[0];
917 $versions{apacheVersion} = `httpd -v` unless $versions{apacheVersion} ;
918 $versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;
919 $versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;
920 $versions{apacheVersion} = `/usr/sbin/apache2 -v` unless $versions{apacheVersion} ;
927 my $C4::Context->timzone
929 Returns a timezone code for the instance of Koha
936 my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
937 if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
938 warn "Invalid timezone in koha-conf.xml ($timezone)";
949 Returns a DateTime::TimeZone object for the system timezone
955 if (!defined $context->{tz}) {
956 my $timezone = $self->timezone;
957 $context->{tz} = DateTime::TimeZone->new(name => $timezone);
959 return $context->{tz};
963 =head2 IsSuperLibrarian
965 C4::Context->IsSuperLibrarian();
969 sub IsSuperLibrarian {
970 my $userenv = C4::Context->userenv;
972 unless ( $userenv and exists $userenv->{flags} ) {
973 # If we reach this without a user environment,
974 # assume that we're running from a command-line script,
975 # and act as a superlibrarian.
976 carp("C4::Context->userenv not defined!");
980 return ($userenv->{flags}//0) % 2;
985 Sets the current interface for later retrieval in any Perl module
987 C4::Context->interface('opac');
988 C4::Context->interface('intranet');
989 my $interface = C4::Context->interface;
994 my ($class, $interface) = @_;
996 if (defined $interface) {
997 $interface = lc $interface;
998 if ( $interface eq 'api'
999 || $interface eq 'opac'
1000 || $interface eq 'intranet'
1001 || $interface eq 'sip'
1002 || $interface eq 'cron'
1003 || $interface eq 'commandline' )
1005 $context->{interface} = $interface;
1007 warn "invalid interface : '$interface'";
1011 return $context->{interface} // 'opac';
1014 # always returns a string for OK comparison via "eq" or "ne"
1016 C4::Context->userenv or return '';
1017 return C4::Context->userenv->{branch} || '';
1020 =head2 only_my_library
1022 my $test = C4::Context->only_my_library;
1024 Returns true if you enabled IndependentBranches and the current user
1025 does not have superlibrarian permissions.
1029 sub only_my_library {
1031 C4::Context->preference('IndependentBranches')
1032 && C4::Context->userenv
1033 && !C4::Context->IsSuperLibrarian()
1034 && C4::Context->userenv->{branch};
1037 =head3 temporary_directory
1039 Returns root directory for temporary storage
1043 sub temporary_directory {
1045 return C4::Context->config('tmp_path') || File::Spec->tmpdir;
1048 =head3 set_remote_address
1050 set_remote_address should be called at the beginning of every script
1051 that is *not* running under plack in order to the REMOTE_ADDR environment
1052 variable to be set correctly.
1056 sub set_remote_address {
1057 if ( C4::Context->config('koha_trusted_proxies') ) {
1059 my $header = CGI->http('HTTP_X_FORWARDED_FOR');
1062 require Koha::Middleware::RealIP;
1063 $ENV{REMOTE_ADDR} = Koha::Middleware::RealIP::get_real_ip( $ENV{REMOTE_ADDR}, $header );
1068 =head3 https_enabled
1070 https_enabled should be called when checking if a HTTPS connection
1073 Note that this depends on a HTTPS environmental variable being defined
1074 by the web server. This function may not return the expected result,
1075 if your web server or reverse proxies are not setting the correct
1076 X-Forwarded-Proto headers and HTTPS environmental variable.
1078 Note too that the HTTPS value can vary from web server to web server.
1079 We are relying on the convention of the value being "on" or "ON" here.
1084 my $https_enabled = 0;
1085 my $env_https = $ENV{HTTPS};
1087 if ($env_https =~ /^ON$/i){
1091 return $https_enabled;
1096 =head3 needs_install
1098 if ( $context->needs_install ) { ... }
1100 This method returns a boolean representing the install status of the Koha instance.
1106 return ($self->preference('Version')) ? 0 : 1;
1115 Specifies the configuration file to read.
1123 Andrew Arensburger <arensb at ooblick dot com>
1125 Joshua Ferraro <jmf at liblime dot com>