Bug 5374 [SIGNED-OFF] Followup: adds conditional check to unit test for late orders

[koha.git] / C4 / Context.pm

diff --git a/C4/Context.pm b/C4/Context.pm
index 484d4e1..770973f 100644 (file)
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -18,7 +18,7 @@ package C4::Context;
 
 use strict;
 use warnings;
-use vars qw($VERSION $AUTOLOAD $context @context_stack);
+use vars qw($VERSION $AUTOLOAD $context @context_stack $servers $memcached $ismemcached);
 
 BEGIN {
        if ($ENV{'HTTP_USER_AGENT'})    {
@@ -78,6 +78,22 @@ BEGIN {
                        $main::SIG{__DIE__} = \&CGI::Carp::confess;
                }
     }          # else there is no browser to send fatals to!
+
+    # Check if there are memcached servers set
+    $servers = $ENV{'MEMCACHED_SERVERS'};
+    if ($servers) {
+        # Load required libraries and create the memcached object
+       require Cache::Memcached;
+       $memcached = Cache::Memcached->new({
+                     servers => [ $servers ],
+                     debug   => 0,
+                     compress_threshold => 10_000,
+                     namespace => $ENV{'MEMCACHED_NAMESPACE'} || 'koha'
+                 });
+        # Verify memcached available (set a variable and test the output)
+       $ismemcached = $memcached->set('ismemcached','1');
+    }
+
        $VERSION = '3.00.00.036';
 }
 
@@ -229,6 +245,11 @@ Returns undef in case of error.
 
 sub read_config_file {         # Pass argument naming config file to read
     my $koha = XMLin(shift, keyattr => ['id'], forcearray => ['listen', 'server', 'serverinfo'], suppressempty => '');
+
+    if ($ismemcached) {
+      $memcached->set('kohaconf',$koha);
+    }
+
     return $koha;                      # Return value: ref-to-hash holding the configuration
 }
 
@@ -237,12 +258,13 @@ sub read_config_file {            # Pass argument naming config file to read
 # 
 sub db_scheme2dbi {
     my $name = shift;
-
+    # for instance, we support only mysql, so don't care checking
+    return "mysql";
     for ($name) {
 # FIXME - Should have other databases. 
-        if (/mysql/i) { return("mysql"); }
+        if (/mysql/) { return("mysql"); }
         if (/Postgres|Pg|PostgresSQL/) { return("Pg"); }
-        if (/oracle/i) { return("Oracle"); }
+        if (/oracle/) { return("Oracle"); }
     }
     return undef;         # Just in case
 }
@@ -274,6 +296,10 @@ Allocates a new context. Initializes the context from the specified
 file, which defaults to either the file given by the C<$KOHA_CONF>
 environment variable, or F</etc/koha/koha-conf.xml>.
 
+It saves the koha-conf.xml values in the declared memcached server(s)
+if currently available and uses those values until them expire and
+re-reads them.
+
 C<&new> does not set this context as the new default context; for
 that, use C<&set_context>.
 
@@ -308,10 +334,20 @@ sub new {
             return undef;
         }
     }
-        # Load the desired config file.
-    $self = read_config_file($conf_fname);
-    $self->{"config_file"} = $conf_fname;
     
+    if ($ismemcached) {
+      # retreive from memcached
+      $self = $memcached->get('kohaconf');
+      if (not defined $self) {
+       # not in memcached yet
+       $self = read_config_file($conf_fname);
+      }
+    } else {
+      # non-memcached env, read from file
+      $self = read_config_file($conf_fname);
+    }
+
+    $self->{"config_file"} = $conf_fname;
     warn "read_config_file($conf_fname) returned undef" if !defined($self->{"config"});
     return undef if !defined($self->{"config"});
 
@@ -462,7 +498,7 @@ my %sysprefs;
 
 sub preference {
     my $self = shift;
-    my $var  = shift;                          # The system preference to return
+    my $var  = lc(shift);                          # The system preference to return
 
     if (exists $sysprefs{$var}) {
         return $sysprefs{$var};
@@ -513,7 +549,7 @@ the sysprefs cache.
 
 sub set_preference {
     my $self = shift;
-    my $var = shift;
+    my $var = lc(shift);
     my $value = shift;
 
     my $dbh = C4::Context->dbh or return 0;
@@ -529,7 +565,9 @@ sub set_preference {
         ON DUPLICATE KEY UPDATE value = VALUES(value)
     " );
 
-    $sth->execute( $var, $value );
+    if($sth->execute( $var, $value )) {
+        $sysprefs{$var} = $value;
+    }
     $sth->finish;
 }
 
@@ -690,7 +728,7 @@ sub _new_dbh
     my $db_passwd = $context->config("pass");
     # MJR added or die here, as we can't work without dbh
     my $dbh= DBI->connect("DBI:$db_driver:dbname=$db_name;host=$db_host;port=$db_port",
-       $db_user, $db_passwd) or die $DBI::errstr;
+    $db_user, $db_passwd, {'RaiseError' => $ENV{DEBUG}?1:0 }) or die $DBI::errstr;
        my $tz = $ENV{TZ};
     if ( $db_driver eq 'mysql' ) { 
         # Koha 3.0 is utf-8, so force utf8 communication between mySQL and koha, whatever the mysql default config.
@@ -914,7 +952,7 @@ sub userenv {
     my $var = $context->{"activeuser"};
     return $context->{"userenv"}->{$var} if (defined $var and defined $context->{"userenv"}->{$var});
     # insecure=1 management
-    if ($context->{"dbh"} && $context->preference('insecure')) {
+    if ($context->{"dbh"} && $context->preference('insecure') eq 'yes') {
         my %insecure;
         $insecure{flags} = '16382';
         $insecure{branchname} ='Insecure';