Bug 28276: Do not fetch config ($KOHA_CONF) from memcached

memcached address and namespace are in $KOHA_CONF, so it is required to
read it before being able to access the cache. And after that,
configuration is kept in memory forever. Storing this in memcached is
useless and even counter-productive, since Koha reads both the file and
the cache

This patch addresses this issue by removing the cache-related code from
C4::Context->new.
It means that C4::Context->new will always read the configuration file,
so this patch also replaces inappropriate calls to
C4::Context->new->config by appropriate calls to C4::Context->config

It also fixes a bug where C4::Context->new would ignore the filepath
given in parameters if there was something in cache.

It also removes a problematic call to Koha::Caches->get_instance.
Because this call was outside of any subroutine, it would have happened
before the initialization of $C4::Context::context (which happen in
C4::Context::import)

Test plan:
1. Do not apply the patch yet
2. Add the following line at the beginning of Koha::Config::read_from_file
    warn "read_from_file($file)";
   This will allow you to check how many times the file is read.
3. Flush memcached and restart starman
4. Check the logs, you should see "read_from_file" a bunch of times
5. Apply the patch
6. Re-add the line from step 2
7. Flush memcached and restart starman
8. Check the logs, you should see "read_from_file" only once
9. Make sure the memcached config from $KOHA_CONF (memcached_servers,
   memcached_namespace) is taken into account by checking the About page

Signed-off-by: Martin Renvoize <martin.renvoize@ptfs-europe.com>

Signed-off-by: Kyle M Hall <kyle@bywatersolutions.com>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

Signed-off-by: Jonathan Druart <jonathan.druart@bugs.koha-community.org>

C4/Auth_with_ldap.pm

@@ -50,7 +50,6 @@ sub ldapserver_error {
 }
 
 use vars qw($mapping @ldaphosts $base $ldapname $ldappassword);
-my $context = C4::Context->new() 	or die 'C4::Context->new failed';
 my $ldap = C4::Context->config("ldapserver") or die 'No "ldapserver" in server hash from KOHA_CONF: ' . $ENV{KOHA_CONF};
 my $prefhost  = $ldap->{hostname}	or die ldapserver_error('hostname');
 my $base      = $ldap->{base}		or die ldapserver_error('base');

C4/Context.pm

@@ -177,7 +177,6 @@ that, use C<&set_context>.
 sub new {
     my $class = shift;
     my $conf_fname = shift;        # Config file to load
-    my $self = {};
 
     # check that the specified config file exists and is not empty
     undef $conf_fname unless 
@@ -191,18 +190,7 @@ sub new {
         }
     }
 
-    my $conf_cache = Koha::Caches->get_instance('config');
-    if ( $conf_cache->cache ) {
-        $self = $conf_cache->get_from_cache('koha_conf');
-    }
-    unless ( $self and %$self ) {
-        $self = Koha::Config->read_from_file($conf_fname);
-        if ( $conf_cache->memcached_cache ) {
-            # FIXME it may be better to use the memcached servers from the config file
-            # to cache it
-            $conf_cache->set_in_cache('koha_conf', $self)
-        }
-    }
+    my $self = Koha::Config->read_from_file($conf_fname);
     unless ( exists $self->{config} or defined $self->{config} ) {
         warn "The config file ($conf_fname) has not been parsed correctly";
         return;
@@ -311,7 +299,7 @@ C<C4::Config-E<gt>new> will not return it.
 sub _common_config {
 	my $var = shift;
 	my $term = shift;
-    return if !defined($context->{$term});
+    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
@@ -344,7 +332,6 @@ with this method.
 
 =cut
 
-my $syspref_cache = Koha::Caches->get_instance('syspref');
 my $use_syspref_cache = 1;
 sub preference {
     my $self = shift;
@@ -356,7 +343,7 @@ sub preference {
     $var = lc $var;
 
     if ($use_syspref_cache) {
-        $syspref_cache = Koha::Caches->get_instance('syspref') unless $syspref_cache;
+        my $syspref_cache = Koha::Caches->get_instance('syspref');
         my $cached_var = $syspref_cache->get_from_cache("syspref_$var");
         return $cached_var if defined $cached_var;
     }
@@ -366,6 +353,7 @@ sub preference {
     my $value = $syspref ? $syspref->value() : undef;
 
     if ( $use_syspref_cache ) {
+        my $syspref_cache = Koha::Caches->get_instance('syspref');
         $syspref_cache->set_in_cache("syspref_$var", $value);
     }
     return $value;
@@ -434,6 +422,7 @@ will not be seen by this process.
 
 sub clear_syspref_cache {
     return unless $use_syspref_cache;
+    my $syspref_cache = Koha::Caches->get_instance('syspref');
     $syspref_cache->flush_all;
 }
 
@@ -487,6 +476,7 @@ sub set_preference {
     }
 
     if ( $use_syspref_cache ) {
+        my $syspref_cache = Koha::Caches->get_instance('syspref');
         $syspref_cache->set_in_cache( "syspref_$variable", $value );
     }
 
@@ -508,6 +498,7 @@ sub delete_preference {
 
     if ( Koha::Config::SysPrefs->find( $var )->delete ) {
         if ( $use_syspref_cache ) {
+            my $syspref_cache = Koha::Caches->get_instance('syspref');
             $syspref_cache->clear_from_cache("syspref_$var");
         }
 

Koha/Cache.pm

@@ -45,6 +45,7 @@ use Module::Load::Conditional qw(can_load);
 use Sereal::Encoder;
 use Sereal::Decoder;
 
+use C4::Context;
 use Koha::Cache::Object;
 use Koha::Config;
 
@@ -78,12 +79,9 @@ sub new {
     # Should we continue to support MEMCACHED ENV vars?
     $self->{'namespace'} ||= $ENV{MEMCACHED_NAMESPACE};
     my @servers = split /,/, $ENV{MEMCACHED_SERVERS} || '';
-    unless ( $self->{namespace} and @servers ) {
-        my $koha_config = Koha::Config->read_from_file( Koha::Config->guess_koha_conf() );
-        $self->{namespace} ||= $koha_config->{config}{memcached_namespace} || 'koha';
-        @servers = split /,/, $koha_config->{config}{memcached_servers} // ''
-            unless @servers;
-    }
+    $self->{namespace} ||= C4::Context->config('memcached_namespace') || 'koha';
+    @servers = split /,/, C4::Context->config('memcached_servers') // ''
+        unless @servers;
     $self->{namespace} .= ":$subnamespace:";
 
     if ( $self->{'default_type'} eq 'memcached'

Koha/Config.pm

@@ -30,7 +30,7 @@ use constant CONFIG_FNAME => "/etc/koha/koha-conf.xml";
 # developers should set the KOHA_CONF environment variable
 my $INSTALLED_CONFIG_FNAME = '__KOHA_CONF_DIR__/koha-conf.xml';
 
-# Should not be called outside of C4::Context or Koha::Cache
+# Should not be called outside of C4::Context
 # use C4::Context->config instead
 sub read_from_file {
     my ( $class, $file ) = @_;

Koha/Database.pm

@@ -49,21 +49,19 @@ sub _new_schema {
 
     require Koha::Schema;
 
-    my $context = C4::Context->new();
-
-    my $db_driver = $context->{db_driver};
-
-    my $db_name   = $context->config("database");
-    my $db_host   = $context->config("hostname");
-    my $db_port   = $context->config("port") || '';
-    my $db_user   = $context->config("user");
-    my $db_passwd = $context->config("pass");
-    my $tls = $context->config("tls");
+    my $db_driver = C4::Context::db_scheme2dbi(C4::Context->config('db_scheme'));;
+
+    my $db_name   = C4::Context->config("database");
+    my $db_host   = C4::Context->config("hostname");
+    my $db_port   = C4::Context->config("port") || '';
+    my $db_user   = C4::Context->config("user");
+    my $db_passwd = C4::Context->config("pass");
+    my $tls = C4::Context->config("tls");
     my $tls_options;
     if( $tls && $tls eq 'yes' ) {
-        my $ca = $context->config('ca');
-        my $cert = $context->config('cert');
-        my $key = $context->config('key');
+        my $ca = C4::Context->config('ca');
+        my $cert = C4::Context->config('cert');
+        my $key = C4::Context->config('key');
         $tls_options = ";mysql_ssl=1;mysql_ssl_client_key=".$key.";mysql_ssl_client_cert=".$cert.";mysql_ssl_ca_file=".$ca;
     }
 

about.pl

@@ -221,8 +221,6 @@ my $warnNoActiveCurrency = (! defined Koha::Acquisition::Currencies->get_active)
 
 my @xml_config_warnings;
 
-my $context = C4::Context->new;
-
 if (    C4::Context->config('zebra_bib_index_mode')
     and C4::Context->config('zebra_bib_index_mode') eq 'grs1' )
 {
@@ -235,9 +233,10 @@ if (    C4::Context->config('zebra_auth_index_mode')
     push @xml_config_warnings, { error => 'zebra_auth_index_mode_is_grs1' };
 }
 
+my $authorityserver = C4::Context->zebraconfig('authorityserver');
 if( (   C4::Context->config('zebra_auth_index_mode')
     and C4::Context->config('zebra_auth_index_mode') eq 'dom' )
-    && ( $context->{'server'}->{'authorityserver'}->{'config'} !~ /zebra-authorities-dom.cfg/ ) )
+    && ( $authorityserver->{config} !~ /zebra-authorities-dom.cfg/ ) )
 {
     push @xml_config_warnings, {
         error => 'zebra_auth_index_mode_mismatch_warn'

admin/systempreferences.pl

@@ -384,8 +384,7 @@ output_html_with_http_headers $input, $cookie, $template->output;
 # .pref files.
 
 sub get_prefs_from_files {
-    my $context       = C4::Context->new();
-    my $path_pref_en  = $context->config('intrahtdocs') .
+    my $path_pref_en  = C4::Context->config('intrahtdocs') .
                         '/prog/en/modules/admin/preferences';
     # Get all .pref file names
     opendir ( my $fh, $path_pref_en );

misc/translator/LangInstaller.pm

@@ -34,7 +34,7 @@ sub set_lang {
     my ($self, $lang) = @_;
 
     $self->{lang} = $lang;
-    $self->{po_path_lang} = $self->{context}->config('intrahtdocs') .
+    $self->{po_path_lang} = C4::Context->config('intrahtdocs') .
                             "/prog/$lang/modules/admin/preferences";
 }
 
@@ -43,9 +43,7 @@ sub new {
 
     my $self                 = { };
 
-    my $context              = C4::Context->new();
-    $self->{context}         = $context;
-    $self->{path_pref_en}    = $context->config('intrahtdocs') .
+    $self->{path_pref_en}    = C4::Context->config('intrahtdocs') .
                                '/prog/en/modules/admin/preferences';
     set_lang( $self, $lang ) if $lang;
     $self->{pref_only}       = $pref_only;
@@ -76,17 +74,17 @@ sub new {
     $self->{langs} = \@langs;
 
     # Map for both interfaces opac/intranet
-    my $opachtdocs = $context->config('opachtdocs');
+    my $opachtdocs = C4::Context->config('opachtdocs');
     $self->{interface} = [
         {
             name   => 'Intranet prog UI',
-            dir    => $context->config('intrahtdocs') . '/prog',
+            dir    => C4::Context->config('intrahtdocs') . '/prog',
             suffix => '-staff-prog.po',
         },
     ];
 
     # OPAC themes
-    opendir my $dh, $context->config('opachtdocs');
+    opendir my $dh, C4::Context->config('opachtdocs');
     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
         push @{$self->{interface}}, {
             name   => "OPAC $theme",
@@ -98,8 +96,8 @@ sub new {
     # MARC flavours (hardcoded list)
     for ( "MARC21", "UNIMARC", "NORMARC" ) {
         # search for strings on staff & opac marc files
-        my $dirs = $context->config('intrahtdocs') . '/prog';
-        opendir $fh, $context->config('opachtdocs');
+        my $dirs = C4::Context->config('intrahtdocs') . '/prog';
+        opendir $fh, C4::Context->config('opachtdocs');
         for ( grep { not /^\.|\.\.|lib$|xslt/ } readdir($fh) ) {
             $dirs .= ' ' . "$opachtdocs/$_";
         }
@@ -140,7 +138,6 @@ sub po_filename {
     my $self   = shift;
     my $suffix = shift;
 
-    my $context    = C4::Context->new;
     my $trans_path = $Bin . '/po';
     my $trans_file = "$trans_path/" . $self->{lang} . $suffix;
     return $trans_file;
@@ -377,8 +374,8 @@ sub install_installer {
     my $self = shift;
     return unless ( $self->{installer} );
 
-    my $intradir  = $self->{context}->config('intranetdir');
-    my $db_scheme = $self->{context}->config('db_scheme');
+    my $intradir  = C4::Context->config('intranetdir');
+    my $db_scheme = C4::Context->config('db_scheme');
     my $langdir  = "$intradir/installer/data/$db_scheme/$self->{lang}";
     if ( -d $langdir ) {
         say "$self->{lang} installer dir $langdir already exists.\nDelete it if you want to recreate it." if $self->{verbose};
@@ -440,13 +437,13 @@ sub install_messages {
     system "$self->{msgfmt} -o $mofile $pofile";
 
     my $js_locale_data = 'var json_locale_data = {"Koha":' . `$self->{po2json} $js_pofile` . '};';
-    my $progdir = $self->{context}->config('intrahtdocs') . '/prog';
+    my $progdir = C4::Context->config('intrahtdocs') . '/prog';
     mkdir "$progdir/$self->{lang}/js";
     open my $fh, '>', "$progdir/$self->{lang}/js/locale_data.js";
     print $fh $js_locale_data;
     close $fh;
 
-    my $opachtdocs = $self->{context}->config('opachtdocs');
+    my $opachtdocs = C4::Context->config('opachtdocs');
     opendir(my $dh, $opachtdocs);
     for my $theme ( grep { not /^\.|lib|xslt/ } readdir($dh) ) {
         mkdir "$opachtdocs/$theme/$self->{lang}/js";