}
};
-use Carp;
+use Carp qw( carp );
use DateTime::TimeZone;
use Encode;
use File::Spec;
-use Module::Load::Conditional qw(can_load);
-use POSIX ();
+use POSIX;
use YAML::XS;
use ZOOM;
+use List::MoreUtils qw(any);
-use C4::Debug;
use Koha::Caches;
use Koha::Config::SysPref;
use Koha::Config::SysPrefs;
$context = undef; # Initially, no context is set
@context_stack = (); # Initially, no saved contexts
-=head2 db_scheme2dbi
-
- my $dbd_driver_name = C4::Context::db_schema2dbi($scheme);
-
-This routines translates a database type to part of the name
-of the appropriate DBD driver to use when establishing a new
-database connection. It recognizes 'mysql' and 'Pg'; if any
-other scheme is supplied it defaults to 'mysql'.
-
-=cut
-
-sub db_scheme2dbi {
- my $scheme = shift // '';
- return $scheme eq 'Pg' ? $scheme : 'mysql';
-}
-
sub import {
# Create the default context ($C4::Context::Context)
# the first time the module is called
}
}
- my $self = Koha::Config->read_from_file($conf_fname);
- unless ( exists $self->{config} or defined $self->{config} ) {
+ my $self = {};
+ $self->{config} = Koha::Config->get_instance($conf_fname);
+ unless ( defined $self->{config} ) {
warn "The config file ($conf_fname) has not been parsed correctly";
return;
}
$self->{tz} = undef; # local timezone object
bless $self, $class;
- $self->{db_driver} = db_scheme2dbi($self->config('db_scheme')); # cache database driver
return $self;
}
$value = C4::Context->config("config_variable");
- $value = C4::Context->config_variable;
-
Returns the value of a variable specified in the configuration file
from which the current context was created.
-The second form is more compact, but of course may conflict with
-method names. If there is a configuration variable called "new", then
-C<C4::Config-E<gt>new> will not return it.
-
=cut
sub _common_config {
- my $var = shift;
- my $term = shift;
- return unless defined $context and defined $context->{$term};
- # Presumably $self->{$term} might be
- # undefined if the config file given to &new
- # didn't exist, and the caller didn't bother
- # to check the return value.
-
- # Return the value of the requested config variable
- return $context->{$term}->{$var};
+ my ($var, $term) = @_;
+
+ return unless defined $context and defined $context->{config};
+
+ return $context->{config}->get($var, $term);
}
sub config {
return 0;
}
+=head2 csv_delimiter
+
+ $delimiter = C4::Context->csv_delimiter;
+
+ Returns preferred CSV delimiter, using system preference 'CSVDelimiter'.
+ If this preference is missing or empty, comma will be returned.
+ This method is needed because of special behavior for tabulation.
+
+ You can, optionally, pass a value parameter to this routine
+ in the case of existing delimiter.
+
+=cut
+
+sub csv_delimiter {
+ my ( $self, $value ) = @_;
+ my $delimiter = $value || $self->preference('CSVDelimiter') || ',';
+ $delimiter = "\t" if $delimiter eq 'tabulation';
+ return $delimiter;
+}
+
=head2 Zconn
$Zconn = C4::Context->Zconn
$syntax = 'xml';
$elementSetName = 'marcxml';
- my $host = $context->{'listen'}->{$server}->{'content'};
- my $user = $context->{"serverinfo"}->{$server}->{"user"};
- my $password = $context->{"serverinfo"}->{$server}->{"password"};
+ my $host = _common_config($server, 'listen')->{content};
+ my $serverinfo = _common_config($server, 'serverinfo');
+ my $user = $serverinfo->{user};
+ my $password = $serverinfo->{password};
eval {
# set options
my $o = ZOOM::Options->new();
$o->option(user => $user) if $user && $password;
$o->option(password => $password) if $user && $password;
$o->option(async => 1) if $async;
- $o->option(cqlfile=> $context->{"server"}->{$server}->{"cql2rpn"});
- $o->option(cclfile=> $context->{"serverinfo"}->{$server}->{"ccl2rpn"});
+ $o->option(cqlfile=> _common_config($server, 'server')->{cql2rpn});
+ $o->option(cclfile=> $serverinfo->{ccl2rpn});
$o->option(preferredRecordSyntax => $syntax);
$o->option(elementSetName => $elementSetName) if $elementSetName;
- $o->option(databaseName => $context->{"config"}->{$server}||"biblios");
+ $o->option(databaseName => _common_config($server, 'config') || 'biblios');
# create a new connection object
$Zconn= create ZOOM::Connection($o);
#'
sub set_userenv {
shift @_;
- my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $shibboleth, $desk_id, $desk_name, $register_id, $register_name)=
- map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
- @_;
+ my (
+ $usernum, $userid, $usercnum, $userfirstname,
+ $usersurname, $userbranch, $branchname, $userflags,
+ $emailaddress, $shibboleth, $desk_id, $desk_name,
+ $register_id, $register_name
+ ) = @_;
+
my $var=$context->{"activeuser"} || '';
my $cell = {
"number" => $usernum,
return $cell;
}
-sub set_shelves_userenv {
- my ($type, $shelves) = @_ or return;
- my $activeuser = $context->{activeuser} or return;
- $context->{userenv}->{$activeuser}->{barshelves} = $shelves if $type eq 'bar';
- $context->{userenv}->{$activeuser}->{pubshelves} = $shelves if $type eq 'pub';
- $context->{userenv}->{$activeuser}->{totshelves} = $shelves if $type eq 'tot';
-}
-
-sub get_shelves_userenv {
- my $active;
- unless ($active = $context->{userenv}->{$context->{activeuser}}) {
- $debug and warn "get_shelves_userenv cannot retrieve context->{userenv}->{context->{activeuser}}";
- return;
- }
- my $totshelves = $active->{totshelves} or undef;
- my $pubshelves = $active->{pubshelves} or undef;
- my $barshelves = $active->{barshelves} or undef;
- return ($totshelves, $pubshelves, $barshelves);
-}
-
=head2 _new_userenv
C4::Context->_new_userenv($session); # FIXME: This calling style is wrong for what looks like an _internal function
sub _unset_userenv
{
my ($sessionID)= @_;
- undef $context->{"activeuser"} if ($context->{"activeuser"} eq $sessionID);
+ undef $context->{activeuser} if $sessionID && $context->{activeuser} && $context->{activeuser} eq $sessionID;
}
return %versions;
}
-=head2 timezone
-
- my $C4::Context->timzone
-
- Returns a timezone code for the instance of Koha
-
-=cut
-
-sub timezone {
- my $self = shift;
-
- my $timezone = C4::Context->config('timezone') || $ENV{TZ} || 'local';
- if ( !DateTime::TimeZone->is_valid_name( $timezone ) ) {
- warn "Invalid timezone in koha-conf.xml ($timezone)";
- $timezone = 'local';
- }
-
- return $timezone;
-}
-
=head2 tz
C4::Context->tz
sub tz {
my $self = shift;
if (!defined $context->{tz}) {
- my $timezone = $self->timezone;
+ my $timezone = $context->{config}->timezone;
$context->{tz} = DateTime::TimeZone->new(name => $timezone);
}
return $context->{tz};
return ($self->preference('Version')) ? 0 : 1;
}
+=head3 is_psgi_or_plack
+
+is_psgi_or_plack returns true if there is an environmental variable
+prefixed with "psgi" or "plack". This is useful for detecting whether
+this is a PSGI app or a CGI app, and implementing code as appropriate.
+
+=cut
+
+sub is_psgi_or_plack {
+ my $is_psgi_or_plack = 0;
+ if ( any { /(^psgi\.|^plack\.)/i } keys %ENV ) {
+ $is_psgi_or_plack = 1;
+ }
+ return $is_psgi_or_plack;
+}
+
+=head3 is_internal_PSGI_request
+
+is_internal_PSGI_request is used to detect if this request was made
+from within the individual PSGI app or externally from the mounted PSGI
+app
+
+=cut
+
+#NOTE: This is not a very robust method but it's the best we have so far
+sub is_internal_PSGI_request {
+ my $is_internal = 0;
+ if ( (__PACKAGE__->is_psgi_or_plack) && ( $ENV{REQUEST_URI} !~ /^(\/intranet|\/opac)/ ) ){
+ $is_internal = 1;
+ }
+ return $is_internal;
+}
+
__END__
=head1 ENVIRONMENT