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);
105 use Koha::Config::SysPref;
106 use Koha::Config::SysPrefs;
112 C4::Context - Maintain and manipulate the context of a Koha script
118 use C4::Context("/path/to/koha-conf.xml");
120 $config_value = C4::Context->config("config_variable");
122 $koha_preference = C4::Context->preference("preference");
124 $db_handle = C4::Context->dbh;
126 $Zconn = C4::Context->Zconn;
130 When a Koha script runs, it makes use of a certain number of things:
131 configuration settings in F</etc/koha/koha-conf.xml>, a connection to the Koha
132 databases, and so forth. These things make up the I<context> in which
135 This module takes care of setting up the context for a script:
136 figuring out which configuration file to load, and loading it, opening
137 a connection to the right database, and so forth.
139 Most scripts will only use one context. They can simply have
145 Other scripts may need to use several contexts. For instance, if a
146 library has two databases, one for a certain collection, and the other
147 for everything else, it might be necessary for a script to use two
148 different contexts to search both databases. Such scripts should use
149 the C<&set_context> and C<&restore_context> functions, below.
151 By default, C4::Context reads the configuration from
152 F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
153 environment variable to the pathname of a configuration file to use.
160 # In addition to what is said in the POD above, a Context object is a
161 # reference-to-hash with the following fields:
164 # A reference-to-hash whose keys and values are the
165 # configuration variables and values specified in the config
166 # file (/etc/koha/koha-conf.xml).
168 # A handle to the appropriate database for this context.
170 # Used by &set_dbh and &restore_dbh to hold other database
171 # handles for this context.
173 # A connection object for the Zebra server
175 $context = undef; # Initially, no context is set
176 @context_stack = (); # Initially, no saved contexts
180 my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
182 This routines translates a database type to part of the name
183 of the appropriate DBD driver to use when establishing a new
184 database connection. It recognizes 'mysql' and 'Pg'; if any
185 other scheme is supplied it defaults to 'mysql'.
190 my $scheme = shift // '';
191 return $scheme eq 'Pg' ? $scheme : 'mysql';
195 # Create the default context ($C4::Context::Context)
196 # the first time the module is called
197 # (a config file can be optionaly passed)
199 # default context already exists?
203 my ($pkg,$config_file) = @_ ;
204 my $new_ctx = __PACKAGE__->new($config_file);
205 return unless $new_ctx;
207 # if successfully loaded, use it by default
208 $new_ctx->set_context;
214 $context = C4::Context->new;
215 $context = C4::Context->new("/path/to/koha-conf.xml");
217 Allocates a new context. Initializes the context from the specified
218 file, which defaults to either the file given by the C<$KOHA_CONF>
219 environment variable, or F</etc/koha/koha-conf.xml>.
221 It saves the koha-conf.xml values in the declared memcached server(s)
222 if currently available and uses those values until them expire and
225 C<&new> does not set this context as the new default context; for
226 that, use C<&set_context>.
232 # 2004-08-10 A. Tarallo: Added check if the conf file is not empty
235 my $conf_fname = shift; # Config file to load
238 # check that the specified config file exists and is not empty
239 undef $conf_fname unless
240 (defined $conf_fname && -s $conf_fname);
241 # Figure out a good config file to load if none was specified.
242 unless ( defined $conf_fname ) {
243 $conf_fname = Koha::Config->guess_koha_conf;
244 unless ( $conf_fname ) {
245 warn "unable to locate Koha configuration file koha-conf.xml";
250 my $conf_cache = Koha::Caches->get_instance('config');
251 if ( $conf_cache->cache ) {
252 $self = $conf_cache->get_from_cache('koha_conf');
254 unless ( $self and %$self ) {
255 $self = Koha::Config->read_from_file($conf_fname);
256 if ( $conf_cache->memcached_cache ) {
257 # FIXME it may be better to use the memcached servers from the config file
259 $conf_cache->set_in_cache('koha_conf', $self)
262 unless ( exists $self->{config} or defined $self->{config} ) {
263 warn "The config file ($conf_fname) has not been parsed correctly";
267 $self->{"Zconn"} = undef; # Zebra Connections
268 $self->{"userenv"} = undef; # User env
269 $self->{"activeuser"} = undef; # current active user
270 $self->{"shelves"} = undef;
271 $self->{tz} = undef; # local timezone object
274 $self->{db_driver} = db_scheme2dbi($self->config('db_scheme')); # cache database driver
280 $context = new C4::Context;
281 $context->set_context();
283 set_context C4::Context $context;
286 restore_context C4::Context;
288 In some cases, it might be necessary for a script to use multiple
289 contexts. C<&set_context> saves the current context on a stack, then
290 sets the context to C<$context>, which will be used in future
291 operations. To restore the previous context, use C<&restore_context>.
299 my $new_context; # The context to set
301 # Figure out whether this is a class or instance method call.
303 # We're going to make the assumption that control got here
304 # through valid means, i.e., that the caller used an instance
305 # or class method call, and that control got here through the
306 # usual inheritance mechanisms. The caller can, of course,
307 # break this assumption by playing silly buggers, but that's
308 # harder to do than doing it properly, and harder to check
310 if (ref($self) eq "")
312 # Class method. The new context is the next argument.
313 $new_context = shift;
315 # Instance method. The new context is $self.
316 $new_context = $self;
319 # Save the old context, if any, on the stack
320 push @context_stack, $context if defined($context);
322 # Set the new context
323 $context = $new_context;
326 =head2 restore_context
330 Restores the context set by C<&set_context>.
339 if ($#context_stack < 0)
342 die "Context stack underflow";
345 # Pop the old context and set it.
346 $context = pop @context_stack;
348 # FIXME - Should this return something, like maybe the context
349 # that was current when this was called?
354 $value = C4::Context->config("config_variable");
356 $value = C4::Context->config_variable;
358 Returns the value of a variable specified in the configuration file
359 from which the current context was created.
361 The second form is more compact, but of course may conflict with
362 method names. If there is a configuration variable called "new", then
363 C<C4::Config-E<gt>new> will not return it.
370 return if !defined($context->{$term});
371 # Presumably $self->{$term} might be
372 # undefined if the config file given to &new
373 # didn't exist, and the caller didn't bother
374 # to check the return value.
376 # Return the value of the requested config variable
377 return $context->{$term}->{$var};
381 return _common_config($_[1],'config');
384 return _common_config($_[1],'server');
389 $sys_preference = C4::Context->preference('some_variable');
391 Looks up the value of the given system preference in the
392 systempreferences table of the Koha database, and returns it. If the
393 variable is not set or does not exist, undef is returned.
395 In case of an error, this may return 0.
397 Note: It is impossible to tell the difference between system
398 preferences which do not exist, and those whose values are set to NULL
403 my $syspref_cache = Koha::Caches->get_instance('syspref');
404 my $use_syspref_cache = 1;
407 my $var = shift; # The system preference to return
409 return $ENV{"OVERRIDE_SYSPREF_$var"}
410 if defined $ENV{"OVERRIDE_SYSPREF_$var"};
414 if ($use_syspref_cache) {
415 $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache;
416 my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
417 return $cached_var if defined $cached_var;
421 eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
422 my $value = $syspref ? $syspref->value() : undef;
424 if ( $use_syspref_cache ) {
425 $syspref_cache->set_in_cache("syspref_$var", $value);
430 sub boolean_preference {
432 my $var = shift; # The system preference to return
433 my $it = preference($self, $var);
434 return defined($it)? C4::Boolean::true_p($it): undef;
437 =head2 yaml_preference
439 Retrieves the required system preference value, and converts it
440 from YAML into a Perl data structure. It throws an exception if
441 the value cannot be properly decoded as YAML.
445 sub yaml_preference {
446 my ( $self, $preference ) = @_;
448 my $yaml = eval { YAML::Load( $self->preference( $preference ) ); };
450 warn "Unable to parse $preference syspref : $@";
457 =head2 enable_syspref_cache
459 C4::Context->enable_syspref_cache();
461 Enable the in-memory syspref cache used by C4::Context. This is the
466 sub enable_syspref_cache {
468 $use_syspref_cache = 1;
469 # We need to clear the cache to have it up-to-date
470 $self->clear_syspref_cache();
473 =head2 disable_syspref_cache
475 C4::Context->disable_syspref_cache();
477 Disable the in-memory syspref cache used by C4::Context. This should be
478 used with Plack and other persistent environments.
482 sub disable_syspref_cache {
484 $use_syspref_cache = 0;
485 $self->clear_syspref_cache();
488 =head2 clear_syspref_cache
490 C4::Context->clear_syspref_cache();
492 cleans the internal cache of sysprefs. Please call this method if
493 you update the systempreferences table. Otherwise, your new changes
494 will not be seen by this process.
498 sub clear_syspref_cache {
499 return unless $use_syspref_cache;
500 $syspref_cache->flush_all;
503 =head2 set_preference
505 C4::Context->set_preference( $variable, $value, [ $explanation, $type, $options ] );
507 This updates a preference's value both in the systempreferences table and in
508 the sysprefs cache. If the optional parameters are provided, then the query
509 becomes a create. It won't update the parameters (except value) for an existing
515 my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
517 my $variable_case = $variable;
518 $variable = lc $variable;
520 my $syspref = Koha::Config::SysPrefs->find($variable);
523 : $syspref ? $syspref->type
526 $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
528 # force explicit protocol on OPACBaseURL
529 if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) {
530 $value = 'http://' . $value;
535 { ( defined $value ? ( value => $value ) : () ),
536 ( $explanation ? ( explanation => $explanation ) : () ),
537 ( $type ? ( type => $type ) : () ),
538 ( $options ? ( options => $options ) : () ),
542 $syspref = Koha::Config::SysPref->new(
543 { variable => $variable_case,
545 explanation => $explanation || undef,
547 options => $options || undef,
552 if ( $use_syspref_cache ) {
553 $syspref_cache->set_in_cache( "syspref_$variable", $value );
559 =head2 delete_preference
561 C4::Context->delete_preference( $variable );
563 This deletes a system preference from the database. Returns a true value on
564 success. Failure means there was an issue with the database, not that there
565 was no syspref of the name.
569 sub delete_preference {
570 my ( $self, $var ) = @_;
572 if ( Koha::Config::SysPrefs->find( $var )->delete ) {
573 if ( $use_syspref_cache ) {
574 $syspref_cache->clear_from_cache("syspref_$var");
584 $Zconn = C4::Context->Zconn
586 Returns a connection to the Zebra database
590 C<$server> one of the servers defined in the koha-conf.xml file
592 C<$async> whether this is a asynchronous connection
597 my ($self, $server, $async ) = @_;
598 my $cache_key = join ('::', (map { $_ // '' } ($server, $async )));
599 if ( (!defined($ENV{GATEWAY_INTERFACE})) && defined($context->{"Zconn"}->{$cache_key}) && (0 == $context->{"Zconn"}->{$cache_key}->errcode()) ) {
600 # if we are running the script from the commandline, lets try to use the caching
601 return $context->{"Zconn"}->{$cache_key};
603 $context->{"Zconn"}->{$cache_key}->destroy() if defined($context->{"Zconn"}->{$cache_key}); #destroy old connection before making a new one
604 $context->{"Zconn"}->{$cache_key} = &_new_Zconn( $server, $async );
605 return $context->{"Zconn"}->{$cache_key};
610 $context->{"Zconn"} = &_new_Zconn($server,$async);
612 Internal function. Creates a new database connection from the data given in the current context and returns it.
614 C<$server> one of the servers defined in the koha-conf.xml file
616 C<$async> whether this is a asynchronous connection
618 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
623 my ( $server, $async ) = @_;
625 my $tried=0; # first attempt
626 my $Zconn; # connection object
630 $server //= "biblioserver";
633 $elementSetName = 'marcxml';
635 my $host = $context->{'listen'}->{$server}->{'content'};
636 my $user = $context->{"serverinfo"}->{$server}->{"user"};
637 my $password = $context->{"serverinfo"}->{$server}->{"password"};
640 my $o = ZOOM::Options->new();
641 $o->option(user => $user) if $user && $password;
642 $o->option(password => $password) if $user && $password;
643 $o->option(async => 1) if $async;
644 $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
645 $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
646 $o->option(preferredRecordSyntax => $syntax);
647 $o->option(elementSetName => $elementSetName) if $elementSetName;
648 $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
650 # create a new connection object
651 $Zconn= create ZOOM::Connection($o);
654 $Zconn->connect($host, 0);
656 # check for errors and warn
657 if ($Zconn->errcode() !=0) {
658 warn "something wrong with the connection: ". $Zconn->errmsg();
665 # Internal helper function (not a method!). This creates a new
666 # database connection from the data given in the current context, and
671 Koha::Database->schema({ new => 1 })->storage->dbh;
676 $dbh = C4::Context->dbh;
678 Returns a database handle connected to the Koha database for the
679 current context. If no connection has yet been made, this method
680 creates one, and connects to the database.
682 This database handle is cached for future use: if you call
683 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
684 times. If you need a second database handle, use C<&new_dbh> and
685 possibly C<&set_dbh>.
695 unless ( $params->{new} ) {
696 return Koha::Database->schema->storage->dbh;
699 return Koha::Database->schema({ new => 1 })->storage->dbh;
704 $dbh = C4::Context->new_dbh;
706 Creates a new connection to the Koha database for the current context,
707 and returns the database handle (a C<DBI::db> object).
709 The handle is not saved anywhere: this method is strictly a
710 convenience function; the point is that it knows which database to
711 connect to so that the caller doesn't have to know.
720 return &dbh({ new => 1 });
725 $my_dbh = C4::Connect->new_dbh;
726 C4::Connect->set_dbh($my_dbh);
728 C4::Connect->restore_dbh;
730 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
731 C<&set_context> and C<&restore_context>.
733 C<&set_dbh> saves the current database handle on a stack, then sets
734 the current database handle to C<$my_dbh>.
736 C<$my_dbh> is assumed to be a good database handle.
746 # Save the current database handle on the handle stack.
747 # We assume that $new_dbh is all good: if the caller wants to
748 # screw himself by passing an invalid handle, that's fine by
750 push @{$context->{"dbh_stack"}}, $context->{"dbh"};
751 $context->{"dbh"} = $new_dbh;
756 C4::Context->restore_dbh;
758 Restores the database handle saved by an earlier call to
759 C<C4::Context-E<gt>set_dbh>.
768 if ($#{$context->{"dbh_stack"}} < 0)
771 die "DBH stack underflow";
774 # Pop the old database handle and set it.
775 $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
777 # FIXME - If it is determined that restore_context should
778 # return something, then this function should, too.
783 C4::Context->userenv;
785 Retrieves a hash for user environment variables.
787 This hash shall be cached for future use: if you call
788 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
794 my $var = $context->{"activeuser"};
795 if (defined $var and defined $context->{"userenv"}->{$var}) {
796 return $context->{"userenv"}->{$var};
804 C4::Context->set_userenv($usernum, $userid, $usercnum,
805 $userfirstname, $usersurname,
806 $userbranch, $branchname, $userflags,
807 $emailaddress, $shibboleth
808 $desk_id, $desk_name,
811 Establish a hash of user environment variables.
813 set_userenv is called in Auth.pm
820 my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $shibboleth, $desk_id, $desk_name, $register_id)=
821 map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
823 my $var=$context->{"activeuser"} || '';
825 "number" => $usernum,
827 "cardnumber" => $usercnum,
828 "firstname" => $userfirstname,
829 "surname" => $usersurname,
831 #possibly a law problem
832 "branch" => $userbranch,
833 "branchname" => $branchname,
834 "flags" => $userflags,
835 "emailaddress" => $emailaddress,
836 "shibboleth" => $shibboleth,
837 "desk_id" => $desk_id,
838 "desk_name" => $desk_name,
839 "register_id" => $register_id,
841 $context->{userenv}->{$var} = $cell;
845 sub set_shelves_userenv {
846 my ($type, $shelves) = @_ or return;
847 my $activeuser = $context->{activeuser} or return;
848 $context->{userenv}->{$activeuser}->{barshelves} = $shelves if $type eq 'bar';
849 $context->{userenv}->{$activeuser}->{pubshelves} = $shelves if $type eq 'pub';
850 $context->{userenv}->{$activeuser}->{totshelves} = $shelves if $type eq 'tot';
853 sub get_shelves_userenv {
855 unless ($active = $context->{userenv}->{$context->{activeuser}}) {
856 $debug and warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
859 my $totshelves = $active->{totshelves} or undef;
860 my $pubshelves = $active->{pubshelves} or undef;
861 my $barshelves = $active->{barshelves} or undef;
862 return ($totshelves, $pubshelves, $barshelves);
867 C4::Context->_new_userenv($session); # FIXME: This calling style is wrong for what looks like an _internal function
869 Builds a hash for user environment variables.
871 This hash shall be cached for future use: if you call
872 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
874 _new_userenv is called in Auth.pm
881 shift; # Useless except it compensates for bad calling style
883 $context->{"activeuser"}=$sessionID;
886 =head2 _unset_userenv
888 C4::Context->_unset_userenv;
890 Destroys the hash for activeuser user environment variables.
899 undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
905 C4::Context->get_versions
907 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'.
913 # A little example sub to show more debugging info for CGI::Carp
916 $versions{kohaVersion} = Koha::version();
917 $versions{kohaDbVersion} = C4::Context->preference('version');
918 $versions{osVersion} = join(" ", POSIX::uname());
919 $versions{perlVersion} = $];
921 no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
922 $versions{mysqlVersion} = `mysql -V`;
923 $versions{apacheVersion} = (`apache2ctl -v`)[0];
924 $versions{apacheVersion} = `httpd -v` unless $versions{apacheVersion} ;
925 $versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;
926 $versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;
927 $versions{apacheVersion} = `/usr/sbin/apache2 -v` unless $versions{apacheVersion} ;
934 my $C4::Context->timzone
936 Returns a timezone code for the instance of Koha
943 my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
944 if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
945 warn "Invalid timezone in koha-conf.xml ($timezone)";
956 Returns a DateTime::TimeZone object for the system timezone
962 if (!defined $context->{tz}) {
963 my $timezone = $self->timezone;
964 $context->{tz} = DateTime::TimeZone->new(name => $timezone);
966 return $context->{tz};
970 =head2 IsSuperLibrarian
972 C4::Context->IsSuperLibrarian();
976 sub IsSuperLibrarian {
977 my $userenv = C4::Context->userenv;
979 unless ( $userenv and exists $userenv->{flags} ) {
980 # If we reach this without a user environment,
981 # assume that we're running from a command-line script,
982 # and act as a superlibrarian.
983 carp("C4::Context->userenv not defined!");
987 return ($userenv->{flags}//0) % 2;
992 Sets the current interface for later retrieval in any Perl module
994 C4::Context->interface('opac');
995 C4::Context->interface('intranet');
996 my $interface = C4::Context->interface;
1001 my ($class, $interface) = @_;
1003 if (defined $interface) {
1004 $interface = lc $interface;
1005 if ( $interface eq 'api'
1006 || $interface eq 'opac'
1007 || $interface eq 'intranet'
1008 || $interface eq 'sip'
1009 || $interface eq 'cron'
1010 || $interface eq 'commandline' )
1012 $context->{interface} = $interface;
1014 warn "invalid interface : '$interface'";
1018 return $context->{interface} // 'opac';
1021 # always returns a string for OK comparison via "eq" or "ne"
1023 C4::Context->userenv or return '';
1024 return C4::Context->userenv->{branch} || '';
1027 =head2 only_my_library
1029 my $test = C4::Context->only_my_library;
1031 Returns true if you enabled IndependentBranches and the current user
1032 does not have superlibrarian permissions.
1036 sub only_my_library {
1038 C4::Context->preference('IndependentBranches')
1039 && C4::Context->userenv
1040 && !C4::Context->IsSuperLibrarian()
1041 && C4::Context->userenv->{branch};
1044 =head3 temporary_directory
1046 Returns root directory for temporary storage
1050 sub temporary_directory {
1052 return C4::Context->config('tmp_path') || File::Spec->tmpdir;
1055 =head3 set_remote_address
1057 set_remote_address should be called at the beginning of every script
1058 that is *not* running under plack in order to the REMOTE_ADDR environment
1059 variable to be set correctly.
1063 sub set_remote_address {
1064 if ( C4::Context->config('koha_trusted_proxies') ) {
1066 my $header = CGI->http('HTTP_X_FORWARDED_FOR');
1069 require Koha::Middleware::RealIP;
1070 $ENV{REMOTE_ADDR} = Koha::Middleware::RealIP::get_real_ip( $ENV{REMOTE_ADDR}, $header );
1075 =head3 https_enabled
1077 https_enabled should be called when checking if a HTTPS connection
1080 Note that this depends on a HTTPS environmental variable being defined
1081 by the web server. This function may not return the expected result,
1082 if your web server or reverse proxies are not setting the correct
1083 X-Forwarded-Proto headers and HTTPS environmental variable.
1085 Note too that the HTTPS value can vary from web server to web server.
1086 We are relying on the convention of the value being "on" or "ON" here.
1091 my $https_enabled = 0;
1092 my $env_https = $ENV{HTTPS};
1094 if ($env_https =~ /^ON$/i){
1098 return $https_enabled;
1103 =head3 needs_install
1105 if ( $context->needs_install ) { ... }
1107 This method returns a boolean representing the install status of the Koha instance.
1113 return ($self->preference('Version')) ? 0 : 1;
1122 Specifies the configuration file to read.
1130 Andrew Arensburger <arensb at ooblick dot com>
1132 Joshua Ferraro <jmf at liblime dot com>