Bug 26432: Remove unused ModZebrations
[srvgit] / C4 / Context.pm
index 1aa08be..585332c 100644 (file)
@@ -90,20 +90,22 @@ BEGIN {
     }          # else there is no browser to send fatals to!
 }
 
-use Encode;
-use ZOOM;
-use Koha::Caches;
-use POSIX ();
+use Carp;
 use DateTime::TimeZone;
+use Encode;
+use File::Spec;
 use Module::Load::Conditional qw(can_load);
-use Carp;
+use POSIX ();
+use YAML qw/Load/;
+use ZOOM;
 
 use C4::Boolean;
 use C4::Debug;
-use Koha;
-use Koha::Config;
+use Koha::Caches;
 use Koha::Config::SysPref;
 use Koha::Config::SysPrefs;
+use Koha::Config;
+use Koha;
 
 =head1 NAME
 
@@ -246,7 +248,6 @@ sub new {
     }
 
     my $conf_cache = Koha::Caches->get_instance('config');
-    my $config_from_cache;
     if ( $conf_cache->cache ) {
         $self = $conf_cache->get_from_cache('koha_conf');
     }
@@ -382,9 +383,6 @@ sub config {
 sub zebraconfig {
        return _common_config($_[1],'server');
 }
-sub ModZebrations {
-       return _common_config($_[1],'serverinfo');
-}
 
 =head2 preference
 
@@ -436,6 +434,26 @@ sub boolean_preference {
     return defined($it)? C4::Boolean::true_p($it): undef;
 }
 
+=head2 yaml_preference
+
+Retrieves the required system preference value, and converts it
+from YAML into a Perl data structure. It throws an exception if
+the value cannot be properly decoded as YAML.
+
+=cut
+
+sub yaml_preference {
+    my ( $self, $preference ) = @_;
+
+    my $yaml = eval { YAML::Load( $self->preference( $preference ) ); };
+    if ($@) {
+        warn "Unable to parse $preference syspref : $@";
+        return;
+    }
+
+    return $yaml;
+}
+
 =head2 enable_syspref_cache
 
   C4::Context->enable_syspref_cache();
@@ -496,6 +514,7 @@ preference.
 sub set_preference {
     my ( $self, $variable, $value, $explanation, $type, $options ) = @_;
 
+    my $variable_case = $variable;
     $variable = lc $variable;
 
     my $syspref = Koha::Config::SysPrefs->find($variable);
@@ -521,7 +540,7 @@ sub set_preference {
         )->store;
     } else {
         $syspref = Koha::Config::SysPref->new(
-            {   variable    => $variable,
+            {   variable    => $variable_case,
                 value       => $value,
                 explanation => $explanation || undef,
                 type        => $type,
@@ -606,27 +625,12 @@ sub _new_Zconn {
     my $tried=0; # first attempt
     my $Zconn; # connection object
     my $elementSetName;
-    my $index_mode;
     my $syntax;
 
     $server //= "biblioserver";
 
-    if ( $server eq 'biblioserver' ) {
-        $index_mode = $context->{'config'}->{'zebra_bib_index_mode'} // 'dom';
-    } elsif ( $server eq 'authorityserver' ) {
-        $index_mode = $context->{'config'}->{'zebra_auth_index_mode'} // 'dom';
-    }
-
-    if ( $index_mode eq 'grs1' ) {
-        $elementSetName = 'F';
-        $syntax = ( $context->preference("marcflavour") eq 'UNIMARC' )
-                ? 'unimarc'
-                : 'usmarc';
-
-    } else { # $index_mode eq 'dom'
-        $syntax = 'xml';
-        $elementSetName = 'marcxml';
-    }
+    $syntax = 'xml';
+    $elementSetName = 'marcxml';
 
     my $host = $context->{'listen'}->{$server}->{'content'};
     my $user = $context->{"serverinfo"}->{$server}->{"user"};
@@ -687,7 +691,6 @@ sub dbh
 {
     my $self = shift;
     my $params = shift;
-    my $sth;
 
     unless ( $params->{new} ) {
         return Koha::Database->schema->storage->dbh;
@@ -775,53 +778,6 @@ sub restore_dbh
     # return something, then this function should, too.
 }
 
-=head2 queryparser
-
-  $queryparser = C4::Context->queryparser
-
-Returns a handle to an initialized Koha::QueryParser::Driver::PQF object.
-
-=cut
-
-sub queryparser {
-    my $self = shift;
-    unless (defined $context->{"queryparser"}) {
-        $context->{"queryparser"} = &_new_queryparser();
-    }
-
-    return
-      defined( $context->{"queryparser"} )
-      ? $context->{"queryparser"}->new
-      : undef;
-}
-
-=head2 _new_queryparser
-
-Internal helper function to create a new QueryParser object. QueryParser
-is loaded dynamically so as to keep the lack of the QueryParser library from
-getting in anyone's way.
-
-=cut
-
-sub _new_queryparser {
-    my $qpmodules = {
-        'OpenILS::QueryParser'           => undef,
-        'Koha::QueryParser::Driver::PQF' => undef
-    };
-    if ( can_load( 'modules' => $qpmodules ) ) {
-        my $QParser     = Koha::QueryParser::Driver::PQF->new();
-        my $config_file = $context->config('queryparser_config');
-        $config_file ||= '/etc/koha/searchengine/queryparser.yaml';
-        if ( $QParser->load_config($config_file) ) {
-            # Set 'keyword' as the default search class
-            $QParser->default_search_class('keyword');
-            # TODO: allow indexes to be configured in the database
-            return $QParser;
-        }
-    }
-    return;
-}
-
 =head2 userenv
 
   C4::Context->userenv;
@@ -848,7 +804,8 @@ sub userenv {
   C4::Context->set_userenv($usernum, $userid, $usercnum,
                            $userfirstname, $usersurname,
                            $userbranch, $branchname, $userflags,
-                           $emailaddress, $branchprinter, $shibboleth);
+                           $emailaddress, $shibboleth
+                           $desk_id, $desk_name);
 
 Establish a hash of user environment variables.
 
@@ -859,7 +816,7 @@ set_userenv is called in Auth.pm
 #'
 sub set_userenv {
     shift @_;
-    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $branchprinter, $shibboleth)=
+    my ($usernum, $userid, $usercnum, $userfirstname, $usersurname, $userbranch, $branchname, $userflags, $emailaddress, $shibboleth, $desk_id, $desk_name)=
     map { Encode::is_utf8( $_ ) ? $_ : Encode::decode('UTF-8', $_) } # CGI::Session doesn't handle utf-8, so we decode it here
     @_;
     my $var=$context->{"activeuser"} || '';
@@ -872,9 +829,10 @@ sub set_userenv {
         #possibly a law problem
         "branch"     => $userbranch,
         "branchname" => $branchname,
+        "desk_id"    => $desk_id,
+        "desk_name"  => $desk_name,
         "flags"      => $userflags,
         "emailaddress"     => $emailaddress,
-        "branchprinter"    => $branchprinter,
         "shibboleth" => $shibboleth,
     };
     $context->{userenv}->{$var} = $cell;
@@ -968,6 +926,25 @@ sub get_versions {
     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
 
@@ -980,7 +957,8 @@ sub get_versions {
 sub tz {
     my $self = shift;
     if (!defined $context->{tz}) {
-        $context->{tz} = DateTime::TimeZone->new(name => 'local');
+        my $timezone = $self->timezone;
+        $context->{tz} = DateTime::TimeZone->new(name => $timezone);
     }
     return $context->{tz};
 }
@@ -1021,7 +999,13 @@ sub interface {
 
     if (defined $interface) {
         $interface = lc $interface;
-        if ($interface eq 'opac' || $interface eq 'intranet' || $interface eq 'sip' || $interface eq 'commandline') {
+        if (   $interface eq 'api'
+            || $interface eq 'opac'
+            || $interface eq 'intranet'
+            || $interface eq 'sip'
+            || $interface eq 'cron'
+            || $interface eq 'commandline' )
+        {
             $context->{interface} = $interface;
         } else {
             warn "invalid interface : '$interface'";
@@ -1054,8 +1038,78 @@ sub only_my_library {
       && C4::Context->userenv->{branch};
 }
 
+=head3 temporary_directory
+
+Returns root directory for temporary storage
+
+=cut
+
+sub temporary_directory {
+    my ( $class ) = @_;
+    return C4::Context->config('tmp_path') || File::Spec->tmpdir;
+}
+
+=head3 set_remote_address
+
+set_remote_address should be called at the beginning of every script
+that is *not* running under plack in order to the REMOTE_ADDR environment
+variable to be set correctly.
+
+=cut
+
+sub set_remote_address {
+    if ( C4::Context->config('koha_trusted_proxies') ) {
+        require CGI;
+        my $header = CGI->http('HTTP_X_FORWARDED_FOR');
+
+        if ($header) {
+            require Koha::Middleware::RealIP;
+            $ENV{REMOTE_ADDR} = Koha::Middleware::RealIP::get_real_ip( $ENV{REMOTE_ADDR}, $header );
+        }
+    }
+}
+
+=head3 https_enabled
+
+https_enabled should be called when checking if a HTTPS connection
+is used.
+
+Note that this depends on a HTTPS environmental variable being defined
+by the web server. This function may not return the expected result,
+if your web server or reverse proxies are not setting the correct
+X-Forwarded-Proto headers and HTTPS environmental variable.
+
+Note too that the HTTPS value can vary from web server to web server.
+We are relying on the convention of the value being "on" or "ON" here.
+
+=cut
+
+sub https_enabled {
+    my $https_enabled = 0;
+    my $env_https = $ENV{HTTPS};
+    if ($env_https){
+        if ($env_https =~ /^ON$/i){
+            $https_enabled = 1;
+        }
+    }
+    return $https_enabled;
+}
+
 1;
 
+=head3 needs_install
+
+    if ( $context->needs_install ) { ... }
+
+This method returns a boolean representing the install status of the Koha instance.
+
+=cut
+
+sub needs_install {
+    my ($self) = @_;
+    return ($self->preference('Version')) ? 0 : 1;
+}
+
 __END__
 
 =head1 ENVIRONMENT