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'} ) { # Only hit when plack is not enabled
26 # Redefine multi_param if cgi version is < 4.08
27 # Remove the "CGI::param called in list context" warning in this case
28 require CGI; # Can't check version without the require.
29 if ( !defined($CGI::VERSION) || $CGI::VERSION < 4.08 ) {
30 no warnings 'redefine';
31 *CGI::multi_param = \&CGI::param;
32 use warnings 'redefine';
33 $CGI::LIST_CONTEXT_WARN = 0;
39 use DateTime::TimeZone;
45 use List::MoreUtils qw(any);
48 use Koha::Config::SysPref;
49 use Koha::Config::SysPrefs;
55 C4::Context - Maintain and manipulate the context of a Koha script
61 use C4::Context("/path/to/koha-conf.xml");
63 $config_value = C4::Context->config("config_variable");
65 $koha_preference = C4::Context->preference("preference");
67 $db_handle = C4::Context->dbh;
69 $Zconn = C4::Context->Zconn;
73 When a Koha script runs, it makes use of a certain number of things:
74 configuration settings in F</etc/koha/koha-conf.xml>, a connection to the Koha
75 databases, and so forth. These things make up the I<context> in which
78 This module takes care of setting up the context for a script:
79 figuring out which configuration file to load, and loading it, opening
80 a connection to the right database, and so forth.
82 Most scripts will only use one context. They can simply have
88 Other scripts may need to use several contexts. For instance, if a
89 library has two databases, one for a certain collection, and the other
90 for everything else, it might be necessary for a script to use two
91 different contexts to search both databases. Such scripts should use
92 the C<&set_context> and C<&restore_context> functions, below.
94 By default, C4::Context reads the configuration from
95 F</etc/koha/koha-conf.xml>. This may be overridden by setting the C<$KOHA_CONF>
96 environment variable to the pathname of a configuration file to use.
103 # In addition to what is said in the POD above, a Context object is a
104 # reference-to-hash with the following fields:
107 # A reference-to-hash whose keys and values are the
108 # configuration variables and values specified in the config
109 # file (/etc/koha/koha-conf.xml).
111 # A handle to the appropriate database for this context.
113 # Used by &set_dbh and &restore_dbh to hold other database
114 # handles for this context.
116 # A connection object for the Zebra server
118 $context = undef; # Initially, no context is set
119 @context_stack = (); # Initially, no saved contexts
122 # Create the default context ($C4::Context::Context)
123 # the first time the module is called
124 # (a config file can be optionaly passed)
126 # default context already exists?
130 my ($pkg,$config_file) = @_ ;
131 my $new_ctx = __PACKAGE__->new($config_file);
132 return unless $new_ctx;
134 # if successfully loaded, use it by default
135 $new_ctx->set_context;
141 $context = C4::Context->new;
142 $context = C4::Context->new("/path/to/koha-conf.xml");
144 Allocates a new context. Initializes the context from the specified
145 file, which defaults to either the file given by the C<$KOHA_CONF>
146 environment variable, or F</etc/koha/koha-conf.xml>.
148 It saves the koha-conf.xml values in the declared memcached server(s)
149 if currently available and uses those values until them expire and
152 C<&new> does not set this context as the new default context; for
153 that, use C<&set_context>.
159 # 2004-08-10 A. Tarallo: Added check if the conf file is not empty
162 my $conf_fname = shift; # Config file to load
164 # check that the specified config file exists and is not empty
165 undef $conf_fname unless
166 (defined $conf_fname && -s $conf_fname);
167 # Figure out a good config file to load if none was specified.
168 unless ( defined $conf_fname ) {
169 $conf_fname = Koha::Config->guess_koha_conf;
170 unless ( $conf_fname ) {
171 warn "unable to locate Koha configuration file koha-conf.xml";
177 $self->{config} = Koha::Config->get_instance($conf_fname);
178 unless ( defined $self->{config} ) {
179 warn "The config file ($conf_fname) has not been parsed correctly";
183 $self->{"Zconn"} = undef; # Zebra Connections
184 $self->{"userenv"} = undef; # User env
185 $self->{"activeuser"} = undef; # current active user
186 $self->{"shelves"} = undef;
187 $self->{tz} = undef; # local timezone object
195 $context = new C4::Context;
196 $context->set_context();
198 set_context C4::Context $context;
201 restore_context C4::Context;
203 In some cases, it might be necessary for a script to use multiple
204 contexts. C<&set_context> saves the current context on a stack, then
205 sets the context to C<$context>, which will be used in future
206 operations. To restore the previous context, use C<&restore_context>.
214 my $new_context; # The context to set
216 # Figure out whether this is a class or instance method call.
218 # We're going to make the assumption that control got here
219 # through valid means, i.e., that the caller used an instance
220 # or class method call, and that control got here through the
221 # usual inheritance mechanisms. The caller can, of course,
222 # break this assumption by playing silly buggers, but that's
223 # harder to do than doing it properly, and harder to check
225 if (ref($self) eq "")
227 # Class method. The new context is the next argument.
228 $new_context = shift;
230 # Instance method. The new context is $self.
231 $new_context = $self;
234 # Save the old context, if any, on the stack
235 push @context_stack, $context if defined($context);
237 # Set the new context
238 $context = $new_context;
241 =head2 restore_context
245 Restores the context set by C<&set_context>.
254 if ($#context_stack < 0)
257 die "Context stack underflow";
260 # Pop the old context and set it.
261 $context = pop @context_stack;
263 # FIXME - Should this return something, like maybe the context
264 # that was current when this was called?
269 $value = C4::Context->config("config_variable");
271 Returns the value of a variable specified in the configuration file
272 from which the current context was created.
277 my ($var, $term) = @_;
279 return unless defined $context and defined $context->{config};
281 return $context->{config}->get($var, $term);
285 return _common_config($_[1],'config');
288 return _common_config($_[1],'server');
293 $sys_preference = C4::Context->preference('some_variable');
295 Looks up the value of the given system preference in the
296 systempreferences table of the Koha database, and returns it. If the
297 variable is not set or does not exist, undef is returned.
299 In case of an error, this may return 0.
301 Note: It is impossible to tell the difference between system
302 preferences which do not exist, and those whose values are set to NULL
307 my $use_syspref_cache = 1;
310 my $var = shift; # The system preference to return
312 return Encode::decode_utf8($ENV{"OVERRIDE_SYSPREF_$var"})
313 if defined $ENV{"OVERRIDE_SYSPREF_$var"};
317 if ($use_syspref_cache) {
318 my $syspref_cache = Koha::Caches->get_instance('syspref');
319 my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
320 return $cached_var if defined $cached_var;
324 eval { $syspref = Koha::Config::SysPrefs->find( lc $var ) };
325 my $value = $syspref ? $syspref->value() : undef;
327 if ( $use_syspref_cache ) {
328 my $syspref_cache = Koha::Caches->get_instance('syspref');
329 $syspref_cache->set_in_cache("syspref_$var", $value);
334 =head2 yaml_preference
336 Retrieves the required system preference value, and converts it
337 from YAML into a Perl data structure. It throws an exception if
338 the value cannot be properly decoded as YAML.
342 sub yaml_preference {
343 my ( $self, $preference ) = @_;
345 my $yaml = eval { YAML::XS::Load( Encode::encode_utf8( $self->preference( $preference ) ) ); };
347 warn "Unable to parse $preference syspref : $@";
351 # TODO Remove next line when enforced elsewhere
352 if( $yaml && lc($preference) eq 'itemsdeniedrenewal' and ref($yaml) ne 'HASH' ) { warn "Hashref expected for $preference"; return; }
356 =head2 multivalue_preference
358 Retrieves the required system preference value, and splits it
359 into pieces using the I<pipe> (|) symbol as separator.
363 sub multivalue_preference {
364 my ( $self, $preference ) = @_;
366 my $syspref = $self->preference($preference) // q{};
367 my $values = [ split qr{\|}, $syspref ];
372 =head2 enable_syspref_cache
374 C4::Context->enable_syspref_cache();
376 Enable the in-memory syspref cache used by C4::Context. This is the
381 sub enable_syspref_cache {
383 $use_syspref_cache = 1;
384 # We need to clear the cache to have it up-to-date
385 $self->clear_syspref_cache();
388 =head2 disable_syspref_cache
390 C4::Context->disable_syspref_cache();
392 Disable the in-memory syspref cache used by C4::Context. This should be
393 used with Plack and other persistent environments.
397 sub disable_syspref_cache {
399 $use_syspref_cache = 0;
400 $self->clear_syspref_cache();
403 =head2 clear_syspref_cache
405 C4::Context->clear_syspref_cache();
407 cleans the internal cache of sysprefs. Please call this method if
408 you update the systempreferences table. Otherwise, your new changes
409 will not be seen by this process.
413 sub clear_syspref_cache {
414 return unless $use_syspref_cache;
415 my $syspref_cache = Koha::Caches->get_instance('syspref');
416 $syspref_cache->flush_all;
419 =head2 set_preference
421 C4::Context->set_preference( $variable, $value, [ $explanation, $type, $options ] );
423 This updates a preference's value both in the systempreferences table and in
424 the sysprefs cache. If the optional parameters are provided, then the query
425 becomes a create. It won't update the parameters (except value) for an existing
431 my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
433 my $variable_case = $variable;
434 $variable = lc $variable;
436 my $syspref = Koha::Config::SysPrefs->find($variable);
439 : $syspref ? $syspref->type
442 $value = 0 if ( $type && $type eq 'YesNo' && $value eq '' );
444 # force explicit protocol on OPACBaseURL
445 if ( $variable eq 'opacbaseurl' && $value && substr( $value, 0, 4 ) !~ /http/ ) {
446 $value = 'http://' . $value;
451 { ( defined $value ? ( value => $value ) : () ),
452 ( $explanation ? ( explanation => $explanation ) : () ),
453 ( $type ? ( type => $type ) : () ),
454 ( $options ? ( options => $options ) : () ),
458 $syspref = Koha::Config::SysPref->new(
459 { variable => $variable_case,
461 explanation => $explanation || undef,
463 options => $options || undef,
468 if ( $use_syspref_cache ) {
469 my $syspref_cache = Koha::Caches->get_instance('syspref');
470 $syspref_cache->set_in_cache( "syspref_$variable", $value );
476 =head2 delete_preference
478 C4::Context->delete_preference( $variable );
480 This deletes a system preference from the database. Returns a true value on
481 success. Failure means there was an issue with the database, not that there
482 was no syspref of the name.
486 sub delete_preference {
487 my ( $self, $var ) = @_;
489 if ( Koha::Config::SysPrefs->find( $var )->delete ) {
490 if ( $use_syspref_cache ) {
491 my $syspref_cache = Koha::Caches->get_instance('syspref');
492 $syspref_cache->clear_from_cache("syspref_$var");
502 $delimiter = C4::Context->csv_delimiter;
504 Returns preferred CSV delimiter, using system preference 'CSVDelimiter'.
505 If this preference is missing or empty, comma will be returned.
506 This method is needed because of special behavior for tabulation.
508 You can, optionally, pass a value parameter to this routine
509 in the case of existing delimiter.
514 my ( $self, $value ) = @_;
515 my $delimiter = $value || $self->preference('CSVDelimiter') || ',';
516 $delimiter = "\t" if $delimiter eq 'tabulation';
520 =head2 default_catalog_sort_by
522 $delimiter = C4::Context->default_catalog_sort_by;
524 Returns default sort by for catalog search.
525 For relevance no sort order is used.
527 For staff interface, depends on system preferences 'defaultSortField' and 'defaultSortOrder'.
528 For OPAC interface, depends on system preferences 'OPACdefaultSortField' and 'OPACdefaultSortOrder'.
532 sub default_catalog_sort_by {
534 my ( $sort_by, $sort_field, $sort_order );
535 if ( C4::Context->interface eq 'opac' ) {
536 $sort_field = C4::Context->preference('OPACdefaultSortField');
537 $sort_order = C4::Context->preference('OPACdefaultSortOrder');
539 $sort_field = C4::Context->preference('defaultSortField');
540 $sort_order = C4::Context->preference('defaultSortOrder');
542 if ( $sort_field && $sort_order ) {
543 if ( $sort_field eq 'relevance' ) {
544 $sort_by = $sort_field;
546 $sort_by = $sort_field . '_' . $sort_order;
554 $Zconn = C4::Context->Zconn
556 Returns a connection to the Zebra database
560 C<$server> one of the servers defined in the koha-conf.xml file
562 C<$async> whether this is a asynchronous connection
567 my ($self, $server, $async ) = @_;
568 my $cache_key = join ('::', (map { $_ // '' } ($server, $async )));
569 if ( (!defined($ENV{GATEWAY_INTERFACE})) && defined($context->{"Zconn"}->{$cache_key}) && (0 == $context->{"Zconn"}->{$cache_key}->errcode()) ) {
570 # if we are running the script from the commandline, lets try to use the caching
571 return $context->{"Zconn"}->{$cache_key};
573 $context->{"Zconn"}->{$cache_key}->destroy() if defined($context->{"Zconn"}->{$cache_key}); #destroy old connection before making a new one
574 $context->{"Zconn"}->{$cache_key} = &_new_Zconn( $server, $async );
575 return $context->{"Zconn"}->{$cache_key};
580 $context->{"Zconn"} = &_new_Zconn($server,$async);
582 Internal function. Creates a new database connection from the data given in the current context and returns it.
584 C<$server> one of the servers defined in the koha-conf.xml file
586 C<$async> whether this is a asynchronous connection
588 C<$auth> whether this connection has rw access (1) or just r access (0 or NULL)
593 my ( $server, $async ) = @_;
595 my $tried=0; # first attempt
596 my $Zconn; # connection object
600 $server //= "biblioserver";
603 $elementSetName = 'marcxml';
605 my $host = _common_config($server, 'listen')->{content};
606 my $serverinfo = _common_config($server, 'serverinfo');
607 my $user = $serverinfo->{user};
608 my $password = $serverinfo->{password};
611 my $o = ZOOM::Options->new();
612 $o->option(user => $user) if $user && $password;
613 $o->option(password => $password) if $user && $password;
614 $o->option(async => 1) if $async;
615 $o->option(cqlfile=> _common_config($server, 'server')->{cql2rpn});
616 $o->option(cclfile=> $serverinfo->{ccl2rpn});
617 $o->option(preferredRecordSyntax => $syntax);
618 $o->option(elementSetName => $elementSetName) if $elementSetName;
619 $o->option(databaseName => _common_config($server, 'config') || 'biblios');
620 my $timeout = C4::Context->config('zebra_connection_timeout') || 30;
621 $o->option(timeout => $timeout);
623 # create a new connection object
624 $Zconn= create ZOOM::Connection($o);
627 $Zconn->connect($host, 0);
629 # check for errors and warn
630 if ($Zconn->errcode() !=0) {
631 warn "something wrong with the connection: ". $Zconn->errmsg();
638 # Internal helper function (not a method!). This creates a new
639 # database connection from the data given in the current context, and
644 Koha::Database->schema({ new => 1 })->storage->dbh;
649 $dbh = C4::Context->dbh;
651 Returns a database handle connected to the Koha database for the
652 current context. If no connection has yet been made, this method
653 creates one, and connects to the database.
655 This database handle is cached for future use: if you call
656 C<C4::Context-E<gt>dbh> twice, you will get the same handle both
657 times. If you need a second database handle, use C<&new_dbh> and
658 possibly C<&set_dbh>.
668 unless ( $params->{new} ) {
669 return Koha::Database->schema->storage->dbh;
672 return Koha::Database->schema({ new => 1 })->storage->dbh;
677 $dbh = C4::Context->new_dbh;
679 Creates a new connection to the Koha database for the current context,
680 and returns the database handle (a C<DBI::db> object).
682 The handle is not saved anywhere: this method is strictly a
683 convenience function; the point is that it knows which database to
684 connect to so that the caller doesn't have to know.
693 return &dbh({ new => 1 });
698 $my_dbh = C4::Connect->new_dbh;
699 C4::Connect->set_dbh($my_dbh);
701 C4::Connect->restore_dbh;
703 C<&set_dbh> and C<&restore_dbh> work in a manner analogous to
704 C<&set_context> and C<&restore_context>.
706 C<&set_dbh> saves the current database handle on a stack, then sets
707 the current database handle to C<$my_dbh>.
709 C<$my_dbh> is assumed to be a good database handle.
719 # Save the current database handle on the handle stack.
720 # We assume that $new_dbh is all good: if the caller wants to
721 # screw himself by passing an invalid handle, that's fine by
723 push @{$context->{"dbh_stack"}}, $context->{"dbh"};
724 $context->{"dbh"} = $new_dbh;
729 C4::Context->restore_dbh;
731 Restores the database handle saved by an earlier call to
732 C<C4::Context-E<gt>set_dbh>.
741 if ($#{$context->{"dbh_stack"}} < 0)
744 die "DBH stack underflow";
747 # Pop the old database handle and set it.
748 $context->{"dbh"} = pop @{$context->{"dbh_stack"}};
750 # FIXME - If it is determined that restore_context should
751 # return something, then this function should, too.
756 C4::Context->userenv;
758 Retrieves a hash for user environment variables.
760 This hash shall be cached for future use: if you call
761 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
767 my $var = $context->{"activeuser"};
768 if (defined $var and defined $context->{"userenv"}->{$var}) {
769 return $context->{"userenv"}->{$var};
777 C4::Context->set_userenv($usernum, $userid, $usercnum,
778 $userfirstname, $usersurname,
779 $userbranch, $branchname, $userflags,
780 $emailaddress, $shibboleth
781 $desk_id, $desk_name,
782 $register_id, $register_name);
784 Establish a hash of user environment variables.
786 set_userenv is called in Auth.pm
794 $usernum, $userid, $usercnum, $userfirstname,
795 $usersurname, $userbranch, $branchname, $userflags,
796 $emailaddress, $shibboleth, $desk_id, $desk_name,
797 $register_id, $register_name
800 my $var=$context->{"activeuser"} || '';
802 "number" => $usernum,
804 "cardnumber" => $usercnum,
805 "firstname" => $userfirstname,
806 "surname" => $usersurname,
808 #possibly a law problem
809 "branch" => $userbranch,
810 "branchname" => $branchname,
811 "flags" => $userflags,
812 "emailaddress" => $emailaddress,
813 "shibboleth" => $shibboleth,
814 "desk_id" => $desk_id,
815 "desk_name" => $desk_name,
816 "register_id" => $register_id,
817 "register_name" => $register_name
819 $context->{userenv}->{$var} = $cell;
825 C4::Context->_new_userenv($session); # FIXME: This calling style is wrong for what looks like an _internal function
827 Builds a hash for user environment variables.
829 This hash shall be cached for future use: if you call
830 C<C4::Context-E<gt>userenv> twice, you will get the same hash without real DB access
832 _new_userenv is called in Auth.pm
839 shift; # Useless except it compensates for bad calling style
841 $context->{"activeuser"}=$sessionID;
844 =head2 _unset_userenv
846 C4::Context->_unset_userenv;
848 Destroys the hash for activeuser user environment variables.
857 undef $context->{activeuser} if $sessionID && $context->{activeuser} && $context->{activeuser} eq $sessionID;
863 C4::Context->get_versions
865 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'.
871 # A little example sub to show more debugging info for CGI::Carp
873 my ( %versions, $mysqlVersion );
874 $versions{kohaVersion} = Koha::version();
875 $versions{kohaDbVersion} = C4::Context->preference('version');
876 $versions{osVersion} = join(" ", POSIX::uname());
877 $versions{perlVersion} = $];
879 my $dbh = C4::Context->dbh;
880 $mysqlVersion = $dbh->get_info(18) if $dbh; # SQL_DBMS_VER
883 no warnings qw(exec); # suppress warnings if unable to find a program in $PATH
884 $mysqlVersion ||= `mysql -V`; # fallback to sql client version?
885 $versions{apacheVersion} = (`apache2ctl -v`)[0];
886 $versions{apacheVersion} = `httpd -v` unless $versions{apacheVersion} ;
887 $versions{apacheVersion} = `httpd2 -v` unless $versions{apacheVersion} ;
888 $versions{apacheVersion} = `apache2 -v` unless $versions{apacheVersion} ;
889 $versions{apacheVersion} = `/usr/sbin/apache2 -v` unless $versions{apacheVersion} ;
891 $versions{mysqlVersion} = $mysqlVersion;
899 Returns a DateTime::TimeZone object for the system timezone
905 if (!defined $context->{tz}) {
906 my $timezone = $context->{config}->timezone;
907 $context->{tz} = DateTime::TimeZone->new(name => $timezone);
909 return $context->{tz};
913 =head2 IsSuperLibrarian
915 C4::Context->IsSuperLibrarian();
919 sub IsSuperLibrarian {
920 my $userenv = C4::Context->userenv;
922 unless ( $userenv and exists $userenv->{flags} ) {
923 # If we reach this without a user environment,
924 # assume that we're running from a command-line script,
925 # and act as a superlibrarian.
926 carp("C4::Context->userenv not defined!");
930 return ($userenv->{flags}//0) % 2;
935 Sets the current interface for later retrieval in any Perl module
937 C4::Context->interface('opac');
938 C4::Context->interface('intranet');
939 my $interface = C4::Context->interface;
944 my ($class, $interface) = @_;
946 if (defined $interface) {
947 $interface = lc $interface;
948 if ( $interface eq 'api'
949 || $interface eq 'opac'
950 || $interface eq 'intranet'
951 || $interface eq 'sip'
952 || $interface eq 'cron'
953 || $interface eq 'commandline' )
955 $context->{interface} = $interface;
957 warn "invalid interface : '$interface'";
961 return $context->{interface} // 'opac';
964 # always returns a string for OK comparison via "eq" or "ne"
966 C4::Context->userenv or return '';
967 return C4::Context->userenv->{branch} || '';
970 =head2 only_my_library
972 my $test = C4::Context->only_my_library;
974 Returns true if you enabled IndependentBranches and the current user
975 does not have superlibrarian permissions.
979 sub only_my_library {
981 C4::Context->preference('IndependentBranches')
982 && C4::Context->userenv
983 && !C4::Context->IsSuperLibrarian()
984 && C4::Context->userenv->{branch};
987 =head3 temporary_directory
989 Returns root directory for temporary storage
993 sub temporary_directory {
995 return C4::Context->config('tmp_path') || File::Spec->tmpdir;
998 =head3 set_remote_address
1000 set_remote_address should be called at the beginning of every script
1001 that is *not* running under plack in order to the REMOTE_ADDR environment
1002 variable to be set correctly.
1006 sub set_remote_address {
1007 if ( C4::Context->config('koha_trusted_proxies') ) {
1009 my $header = CGI->http('HTTP_X_FORWARDED_FOR');
1012 require Koha::Middleware::RealIP;
1013 $ENV{REMOTE_ADDR} = Koha::Middleware::RealIP::get_real_ip( $ENV{REMOTE_ADDR}, $header );
1018 =head3 https_enabled
1020 https_enabled should be called when checking if a HTTPS connection
1023 Note that this depends on a HTTPS environmental variable being defined
1024 by the web server. This function may not return the expected result,
1025 if your web server or reverse proxies are not setting the correct
1026 X-Forwarded-Proto headers and HTTPS environmental variable.
1028 Note too that the HTTPS value can vary from web server to web server.
1029 We are relying on the convention of the value being "on" or "ON" here.
1034 my $https_enabled = 0;
1035 my $env_https = $ENV{HTTPS};
1037 if ($env_https =~ /^ON$/i){
1041 return $https_enabled;
1046 =head3 needs_install
1048 if ( $context->needs_install ) { ... }
1050 This method returns a boolean representing the install status of the Koha instance.
1056 return ($self->preference('Version')) ? 0 : 1;
1061 psgi_env returns true if there is an environmental variable
1062 prefixed with "psgi" or "plack". This is useful for detecting whether
1063 this is a PSGI app or a CGI app, and implementing code as appropriate.
1069 return any { /^(psgi\.|plack\.|PLACK_ENV$)/i } keys %ENV;
1072 =head3 is_internal_PSGI_request
1074 is_internal_PSGI_request is used to detect if this request was made
1075 from within the individual PSGI app or externally from the mounted PSGI
1080 #NOTE: This is not a very robust method but it's the best we have so far
1081 sub is_internal_PSGI_request {
1083 my $is_internal = 0;
1084 if( $self->psgi_env && ( $ENV{REQUEST_URI} !~ /^(\/intranet|\/opac)/ ) ) {
1087 return $is_internal;
1096 Specifies the configuration file to read.
1100 Andrew Arensburger <arensb at ooblick dot com>
1102 Joshua Ferraro <jmf at liblime dot com>