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 = new C4::Context;
215 $context = new C4::Context("/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 my $config_from_cache;
252 if ( $conf_cache->cache ) {
253 $self = $conf_cache->get_from_cache('koha_conf');
255 unless ( $self and %$self ) {
256 $self = Koha
::Config
->read_from_file($conf_fname);
257 if ( $conf_cache->memcached_cache ) {
258 # FIXME it may be better to use the memcached servers from the config file
260 $conf_cache->set_in_cache('koha_conf', $self)
263 unless ( exists $self->{config
} or defined $self->{config
} ) {
264 warn "The config file ($conf_fname) has not been parsed correctly";
268 $self->{"Zconn"} = undef; # Zebra Connections
269 $self->{"userenv"} = undef; # User env
270 $self->{"activeuser"} = undef; # current active user
271 $self->{"shelves"} = undef;
272 $self->{tz
} = undef; # local timezone object
275 $self->{db_driver
} = db_scheme2dbi
($self->config('db_scheme')); # cache database driver
281 $context = new C4::Context;
282 $context->set_context();
284 set_context C4::Context $context;
287 restore_context C4::Context;
289 In some cases, it might be necessary for a script to use multiple
290 contexts. C<&set_context> saves the current context on a stack, then
291 sets the context to C<$context>, which will be used in future
292 operations. To restore the previous context, use C<&restore_context>.
300 my $new_context; # The context to set
302 # Figure out whether this is a class or instance method call.
304 # We're going to make the assumption that control got here
305 # through valid means, i.e., that the caller used an instance
306 # or class method call, and that control got here through the
307 # usual inheritance mechanisms. The caller can, of course,
308 # break this assumption by playing silly buggers, but that's
309 # harder to do than doing it properly, and harder to check
311 if (ref($self) eq "")
313 # Class method. The new context is the next argument.
314 $new_context = shift;
316 # Instance method. The new context is $self.
317 $new_context = $self;
320 # Save the old context, if any, on the stack
321 push @context_stack, $context if defined($context);
323 # Set the new context
324 $context = $new_context;
327 =head2 restore_context
331 Restores the context set by C<&set_context>.
340 if ($#context_stack < 0)
343 die "Context stack underflow";
346 # Pop the old context and set it.
347 $context = pop @context_stack;
349 # FIXME - Should this return something, like maybe the context
350 # that was current when this was called?
355 $value = C4::Context->config("config_variable");
357 $value = C4::Context->config_variable;
359 Returns the value of a variable specified in the configuration file
360 from which the current context was created.
362 The second form is more compact, but of course may conflict with
363 method names. If there is a configuration variable called "new", then
364 C<C4::Config-E<gt>new> will not return it.
371 return if !defined($context->{$term});
372 # Presumably $self->{$term} might be
373 # undefined if the config file given to &new
374 # didn't exist, and the caller didn't bother
375 # to check the return value.
377 # Return the value of the requested config variable
378 return $context->{$term}->{$var};
382 return _common_config
($_[1],'config');
385 return _common_config
($_[1],'server');
388 return _common_config
($_[1],'serverinfo');
393 $sys_preference = C4::Context->preference('some_variable');
395 Looks up the value of the given system preference in the
396 systempreferences table of the Koha database, and returns it. If the
397 variable is not set or does not exist, undef is returned.
399 In case of an error, this may return 0.
401 Note: It is impossible to tell the difference between system
402 preferences which do not exist, and those whose values are set to NULL
407 my $syspref_cache = Koha
::Caches
->get_instance('syspref');
408 my $use_syspref_cache = 1;
411 my $var = shift; # The system preference to return
413 return $ENV{"OVERRIDE_SYSPREF_$var"}
414 if defined $ENV{"OVERRIDE_SYSPREF_$var"};
418 if ($use_syspref_cache) {
419 $syspref_cache = Koha
::Caches
->get_instance('syspref') unless $syspref_cache;
420 my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
421 return $cached_var if defined $cached_var;
425 eval { $syspref = Koha
::Config
::SysPrefs
->find( lc $var ) };
426 my $value = $syspref ?
$syspref->value() : undef;
428 if ( $use_syspref_cache ) {
429 $syspref_cache->set_in_cache("syspref_$var", $value);
434 sub boolean_preference
{
436 my $var = shift; # The system preference to return
437 my $it = preference
($self, $var);
438 return defined($it)? C4
::Boolean
::true_p
($it): undef;
441 =head2 yaml_preference
443 Retrieves the required system preference value, and converts it
444 from YAML into a Perl data structure. It throws an exception if
445 the value cannot be properly decoded as YAML.
449 sub yaml_preference
{
450 my ( $self, $preference ) = @_;
452 my $yaml = eval { YAML
::Load
( $self->preference( $preference ) ); };
454 warn "Unable to parse $preference syspref : $@";
461 =head2 enable_syspref_cache
463 C4::Context->enable_syspref_cache();
465 Enable the in-memory syspref cache used by C4::Context. This is the
470 sub enable_syspref_cache
{
472 $use_syspref_cache = 1;
473 # We need to clear the cache to have it up-to-date
474 $self->clear_syspref_cache();
477 =head2 disable_syspref_cache
479 C4::Context->disable_syspref_cache();
481 Disable the in-memory syspref cache used by C4::Context. This should be
482 used with Plack and other persistent environments.
486 sub disable_syspref_cache
{
488 $use_syspref_cache = 0;
489 $self->clear_syspref_cache();
492 =head2 clear_syspref_cache
494 C4::Context->clear_syspref_cache();
496 cleans the internal cache of sysprefs. Please call this method if
497 you update the systempreferences table. Otherwise, your new changes
498 will not be seen by this process.
502 sub clear_syspref_cache
{
503 return unless $use_syspref_cache;
504 $syspref_cache->flush_all;
507 =head2 set_preference
509 C4::Context->set_preference( $variable, $value, [ $explanation, $type, $options ] );
511 This updates a preference's value both in the systempreferences table and in
512 the sysprefs cache. If the optional parameters are provided, then the query
513 becomes a create. It won't update the parameters (except value) for an existing
519 my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
521 my $variable_case = $variable;
522 $variable = lc $variable;
524 my $syspref = Koha
::Config
::SysPrefs
->find($variable);
527 : $syspref ?
$syspref->type
530 $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
532 # force explicit protocol on OPACBaseURL
533 if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) {
534 $value = 'http://' . $value;
539 { ( defined $value ?
( value
=> $value ) : () ),
540 ( $explanation ?
( explanation
=> $explanation ) : () ),
541 ( $type ?
( type
=> $type ) : () ),
542 ( $options ?
( options
=> $options ) : () ),
546 $syspref = Koha
::Config
::SysPref
->new(
547 { variable
=> $variable_case,
549 explanation
=> $explanation || undef,
551 options
=> $options || undef,
556 if ( $use_syspref_cache ) {
557 $syspref_cache->set_in_cache( "syspref_$variable", $value );
563 =head2 delete_preference
565 C4::Context->delete_preference( $variable );
567 This deletes a system preference from the database. Returns a true value on
568 success. Failure means there was an issue with the database, not that there
569 was no syspref of the name.
573 sub delete_preference
{
574 my ( $self, $var ) = @_;
576 if ( Koha
::Config
::SysPrefs
->find( $var )->delete ) {
577 if ( $use_syspref_cache ) {
578 $syspref_cache->clear_from_cache("syspref_$var");
588 $Zconn = C4::Context->Zconn
590 Returns a connection to the Zebra database
594 C<$server> one of the servers defined in the koha-conf.xml file
596 C<$async> whether this is a asynchronous connection
601 my ($self, $server, $async ) = @_;
602 my $cache_key = join ('::', (map { $_ // '' } ($server, $async )));
603 if ( (!defined($ENV{GATEWAY_INTERFACE
})) && defined($context->{"Zconn"}->{$cache_key}) && (0 == $context->{"Zconn"}->{$cache_key}->errcode()) ) {
604 # if we are running the script from the commandline, lets try to use the caching
605 return $context->{"Zconn"}->{$cache_key};
607 $context->{"Zconn"}->{$cache_key}->destroy() if defined($context->{"Zconn"}->{$cache_key}); #destroy old connection before making a new one
608 $context->{"Zconn"}->{$cache_key} = &_new_Zconn
( $server, $async );
609 return $context->{"Zconn"}->{$cache_key};
614 $context->{"Zconn"} = &_new_Zconn($server,$async);
616 Internal function. Creates a new database connection from the data given in the current context and returns it.
618 C<$server> one of the servers defined in the koha-conf.xml file
620 C<$async> whether this is a asynchronous connection
622 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
627 my ( $server, $async ) = @_;
629 my $tried=0; # first attempt
630 my $Zconn; # connection object
634 $server //= "biblioserver";
637 $elementSetName = 'marcxml';
639 my $host = $context->{'listen'}->{$server}->{'content'};
640 my $user = $context->{"serverinfo"}->{$server}->{"user"};
641 my $password = $context->{"serverinfo"}->{$server}->{"password"};
644 my $o = new ZOOM
::Options
();
645 $o->option(user
=> $user) if $user && $password;
646 $o->option(password
=> $password) if $user && $password;
647 $o->option(async
=> 1) if $async;
648 $o->option(cqlfile
=> $context->{"server"}->{$server}->{"cql2rpn"});
649 $o->option(cclfile
=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
650 $o->option(preferredRecordSyntax
=> $syntax);
651 $o->option(elementSetName
=> $elementSetName) if $elementSetName;
652 $o->option(databaseName
=> $context->{"config"}->{$server}||"biblios");
654 # create a new connection object
655 $Zconn= create ZOOM
::Connection
($o);
658 $Zconn->connect($host, 0);
660 # check for errors and warn
661 if ($Zconn->errcode() !=0) {
662 warn "something wrong with the connection: ". $Zconn->errmsg();
669 # Internal helper function (not a method!). This creates a new
670 # database connection from the data given in the current context, and
675 Koha
::Database
->schema({ new
=> 1 })->storage->dbh;
680 $dbh = C4::Context->dbh;
682 Returns a database handle connected to the Koha database for the
683 current context. If no connection has yet been made, this method
684 creates one, and connects to the database.
686 This database handle is cached for future use: if you call
687 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
688 times. If you need a second database handle, use C<&new_dbh> and
689 possibly C<&set_dbh>.
700 unless ( $params->{new
} ) {
701 return Koha
::Database
->schema->storage->dbh;
704 return Koha
::Database
->schema({ new
=> 1 })->storage->dbh;
709 $dbh = C4::Context->new_dbh;
711 Creates a new connection to the Koha database for the current context,
712 and returns the database handle (a C<DBI::db> object).
714 The handle is not saved anywhere: this method is strictly a
715 convenience function; the point is that it knows which database to
716 connect to so that the caller doesn't have to know.
725 return &dbh
({ new
=> 1 });
730 $my_dbh = C4::Connect->new_dbh;
731 C4::Connect->set_dbh($my_dbh);
733 C4::Connect->restore_dbh;
735 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
736 C<&set_context> and C<&restore_context>.
738 C<&set_dbh> saves the current database handle on a stack, then sets
739 the current database handle to C<$my_dbh>.
741 C<$my_dbh> is assumed to be a good database handle.
751 # Save the current database handle on the handle stack.
752 # We assume that $new_dbh is all good: if the caller wants to
753 # screw himself by passing an invalid handle, that's fine by
755 push @
{$context->{"dbh_stack"}}, $context->{"dbh"};
756 $context->{"dbh"} = $new_dbh;
761 C4::Context->restore_dbh;
763 Restores the database handle saved by an earlier call to
764 C<C4::Context-E<gt>set_dbh>.
773 if ($#{$context->{"dbh_stack"}} < 0)
776 die "DBH stack underflow";
779 # Pop the old database handle and set it.
780 $context->{"dbh"} = pop @
{$context->{"dbh_stack"}};
782 # FIXME - If it is determined that restore_context should
783 # return something, then this function should, too.
788 C4::Context->userenv;
790 Retrieves a hash for user environment variables.
792 This hash shall be cached for future use: if you call
793 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
799 my $var = $context->{"activeuser"};
800 if (defined $var and defined $context->{"userenv"}->{$var}) {
801 return $context->{"userenv"}->{$var};
809 C4::Context->set_userenv($usernum, $userid, $usercnum,
810 $userfirstname, $usersurname,
811 $userbranch, $branchname, $userflags,
812 $emailaddress, $branchprinter, $shibboleth);
814 Establish a hash of user environment variables.
816 set_userenv is called in Auth.pm
823 my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $shibboleth)=
824 map { Encode
::is_utf8
( $_ ) ?
$_ : Encode
::decode
('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
826 my $var=$context->{"activeuser"} || '';
828 "number" => $usernum,
830 "cardnumber" => $usercnum,
831 "firstname" => $userfirstname,
832 "surname" => $usersurname,
833 #possibly a law problem
834 "branch" => $userbranch,
835 "branchname" => $branchname,
836 "flags" => $userflags,
837 "emailaddress" => $emailaddress,
838 "branchprinter" => $branchprinter,
839 "shibboleth" => $shibboleth,
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') ) {
1067 my $header = $cgi->http('HTTP_X_FORWARDED_FOR');
1070 require Koha
::Middleware
::RealIP
;
1071 $ENV{REMOTE_ADDR
} = Koha
::Middleware
::RealIP
::get_real_ip
( $ENV{REMOTE_ADDR
}, $header );
1084 Specifies the configuration file to read.
1092 Andrew Arensburger <arensb at ooblick dot com>
1094 Joshua Ferraro <jmf at liblime dot com>