Bug 27673: Replace YAML with YAML::XS
[koha-ffzg.git] / C4 / Context.pm
index 36d68b1..bf1df49 100644 (file)
@@ -96,7 +96,7 @@ use Encode;
 use File::Spec;
 use Module::Load::Conditional qw(can_load);
 use POSIX ();
-use YAML qw/Load/;
+use YAML::XS;
 use ZOOM;
 
 use C4::Boolean;
@@ -211,8 +211,8 @@ sub import {
 
 =head2 new
 
-  $context = new C4::Context;
-  $context = new C4::Context("/path/to/koha-conf.xml");
+  $context = C4::Context->new;
+  $context = C4::Context->new("/path/to/koha-conf.xml");
 
 Allocates a new context. Initializes the context from the specified
 file, which defaults to either the file given by the C<$KOHA_CONF>
@@ -248,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');
     }
@@ -384,9 +383,6 @@ sub config {
 sub zebraconfig {
        return _common_config($_[1],'server');
 }
-sub ModZebrations {
-       return _common_config($_[1],'serverinfo');
-}
 
 =head2 preference
 
@@ -449,7 +445,7 @@ the value cannot be properly decoded as YAML.
 sub yaml_preference {
     my ( $self, $preference ) = @_;
 
-    my $yaml = eval { YAML::Load( $self->preference( $preference ) ); };
+    my $yaml = eval { YAML::XS::Load( $self->preference( $preference ) ); };
     if ($@) {
         warn "Unable to parse $preference syspref : $@";
         return;
@@ -641,7 +637,7 @@ sub _new_Zconn {
     my $password = $context->{"serverinfo"}->{$server}->{"password"};
     eval {
         # set options
-        my $o = new ZOOM::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;
@@ -695,7 +691,6 @@ sub dbh
 {
     my $self = shift;
     my $params = shift;
-    my $sth;
 
     unless ( $params->{new} ) {
         return Koha::Database->schema->storage->dbh;
@@ -809,7 +804,9 @@ sub userenv {
   C4::Context->set_userenv($usernum, $userid, $usercnum,
                            $userfirstname, $usersurname,
                            $userbranch, $branchname, $userflags,
-                           $emailaddress, $branchprinter, $shibboleth);
+                           $emailaddress, $shibboleth
+                           $desk_id, $desk_name,
+                           $register_id, $register_name);
 
 Establish a hash of user environment variables.
 
@@ -820,7 +817,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, $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 $var=$context->{"activeuser"} || '';
@@ -830,13 +827,17 @@ sub set_userenv {
         "cardnumber" => $usercnum,
         "firstname"  => $userfirstname,
         "surname"    => $usersurname,
+
         #possibly a law problem
-        "branch"     => $userbranch,
-        "branchname" => $branchname,
-        "flags"      => $userflags,
-        "emailaddress"     => $emailaddress,
-        "branchprinter"    => $branchprinter,
-        "shibboleth" => $shibboleth,
+        "branch"        => $userbranch,
+        "branchname"    => $branchname,
+        "flags"         => $userflags,
+        "emailaddress"  => $emailaddress,
+        "shibboleth"    => $shibboleth,
+        "desk_id"       => $desk_id,
+        "desk_name"     => $desk_name,
+        "register_id"   => $register_id,
+        "register_name" => $register_name
     };
     $context->{userenv}->{$var} = $cell;
     return $cell;
@@ -1063,8 +1064,7 @@ variable to be set correctly.
 sub set_remote_address {
     if ( C4::Context->config('koha_trusted_proxies') ) {
         require CGI;
-        my $cgi    = CGI->new;
-        my $header = $cgi->http('HTTP_X_FORWARDED_FOR');
+        my $header = CGI->http('HTTP_X_FORWARDED_FOR');
 
         if ($header) {
             require Koha::Middleware::RealIP;
@@ -1073,8 +1073,47 @@ sub set_remote_address {
     }
 }
 
+=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