The goal of this patch is to avoid unecessary flush of the L1 cache on
creating a new CGI object each time C4::Languages::getlanguage is called
without a CGI object.
The new class Koha::Cache::Memory::Lite must be flushed by the CGI
constructor overide done in the psgi file. This new class will ease
caching of specific stuffs used by running script.
Test plan:
At the OPAC and the intranet interfaces:
Open 2 different browser session to simulate several users
- Clear the cookies of the browsers
- User 1 (U1) an User 2 (U2) should be set to the default language
(depending on the browser settings)
- U1 chooses another language
- U2 refreshes and the language used must be the default one
- U2 chooses a third language
- U1 refreshes and must be still using the one he has choosen.
Try to use a language which is not defined:
Add &language=es-ES (if es-ES is not translated) to the url, you should
not see the Spanish interface.
Signed-off-by: Jacek Ablewicz <abl@biblos.pk.edu.pl>
Signed-off-by: Jesse Weaver <jweaver@bywatersolutions.com>
Signed-off-by: Brendan Gallagher <brendan@bywatersolutions.com>
(cherry picked from commit
f01a07a25e0503d9dbed3a4226cb51a155bcacd4)
Signed-off-by: Julian Maurice <julian.maurice@biblibre.com>
use CGI;
use List::MoreUtils qw( any );
use C4::Context;
+use Koha::Cache::Memory::Lite;
use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
eval {
sub getlanguage {
my ($cgi) = @_;
+ my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
+ my $cache_key = "getlanguage";
+ unless ( $cgi and $cgi->param('language') ) {
+ my $cached = $memory_cache->get_from_cache($cache_key);
+ return $cached if $cached;
+ }
+
$cgi //= new CGI;
my $interface = C4::Context->interface;
my $theme = C4::Context->preference( ( $interface eq 'opac' ) ? 'opacthemes' : 'template' );
}
# Chose language from the URL
- $language = $cgi->param( 'language' );
- if ( defined $language && any { $_ eq $language } @languages) {
- return $language;
+ my $cgi_param_language = $cgi->param( 'language' );
+ if ( defined $cgi_param_language && any { $_ eq $cgi_param_language } @languages) {
+ $language = $cgi_param_language;
}
# cookie
- if ($language = $cgi->cookie('KohaOpacLanguage') ) {
- $language =~ s/[^a-zA-Z_-]*//; # sanitize cookie
+ if (not $language and my $cgi_cookie_language = $cgi->cookie('KohaOpacLanguage') ) {
+ ( $language = $cgi_cookie_language ) =~ s/[^a-zA-Z_-]*//; # sanitize cookie
}
# HTTP_ACCEPT_LANGUAGE
}
# Ignore a lang not selected in sysprefs
- if ( $language && any { $_ eq $language } @languages ) {
- return $language;
+ if ( $language && not any { $_ eq $language } @languages ) {
+ $language = undef;
}
# Pick the first selected syspref language
- $language = shift @languages;
- return $language if $language;
+ $language = shift @languages unless $language;
# Fall back to English if necessary
- return 'en';
+ $language ||= 'en';
+
+ $memory_cache->set_in_cache( $cache_key, $language );
+ return $language;
}
1;
use C4::Context;
+use Koha::Cache::Memory::Lite;
+
__PACKAGE__->mk_accessors(qw( theme activethemes preferredtheme lang filename htdocs interface vars));
sub setlanguagecookie {
my ( $query, $language, $uri ) = @_;
- my $cookie = $query->cookie(
- -name => 'KohaOpacLanguage',
- -value => $language,
- -HttpOnly => 1,
- -expires => '+3y'
- );
+ my $cookie = getlanguagecookie( $query, $language );
+
+ # We do not want to set getlanguage in cache, some additional checks are
+ # done in C4::Languages::getlanguage
+ Koha::Cache::Memory::Lite->get_instance()->clear_from_cache( 'getlanguage' );
+
print $query->redirect(
-uri => $uri,
-cookie => $cookie
--- /dev/null
+package Koha::Cache::Memory::Lite;
+
+# Copyright 2016 Koha Development Team
+#
+# This file is part of Koha.
+#
+# Koha is free software; you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# Koha is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with Koha; if not, see <http://www.gnu.org/licenses>.
+
+=head1 NAME
+
+Koha::Cache::Memory::Lite - Handling caching of objects in memory *only* for Koha
+
+=head1 SYNOPSIS
+
+ use Koha::Cache::Memory::Lite;
+ my $cache = Koha::Cache::Memory::Lite->get_instance();
+ $cache->set($key, $value);
+ my $retrieved_from_cache_value = $cache->get($key);
+ $cache->clear_from_cache($key);
+ $cache->flush();
+
+=head1 DESCRIPTION
+
+Koha in memory only caching routines.
+
+=cut
+
+use Modern::Perl;
+
+use base qw(Class::Accessor);
+
+our %L1_cache;
+
+our $singleton_cache;
+sub get_instance {
+ my ($class) = @_;
+ $singleton_cache = $class->new() unless $singleton_cache;
+ return $singleton_cache;
+}
+
+sub get_from_cache {
+ my ( $self, $key ) = @_;
+ return $L1_cache{$key};
+}
+
+sub set_in_cache {
+ my ( $self, $key, $value ) = @_;
+ $L1_cache{$key} = $value;
+}
+
+sub clear_from_cache {
+ my ( $self, $key ) = @_;
+ delete $L1_cache{$key};
+}
+
+sub flush {
+ my ( $self ) = @_;
+ %L1_cache = ();
+}
+
+1;
use C4::Letters;
use C4::Members;
use C4::XSLT;
+use Koha::Cache;
+use Koha::Cache::Memory::Lite;
use Koha::Database;
use Koha::DateUtils;
my $q = $old_new->( @_ );
$CGI::PARAM_UTF8 = 1;
Koha::Cache->flush_L1_cache();
+ Koha::Cache::Memory::Lite->flush();
return $q;
};
}
my $q = $old_new->( @_ );
$CGI::PARAM_UTF8 = 1;
Koha::Cache->flush_L1_cache();
+ Koha::Cache::Memory::Lite->flush();
return $q;
};
}
use C4::Category;
use Koha::DateUtils;
use Koha::Cache;
+use Koha::Cache::Memory::Lite;
=for preload
use C4::Tags; # FIXME
=cut
use Modern::Perl;
-use Test::More tests => 37;
+use Test::More tests => 39;
my $destructorcount = 0;
BEGIN {
use_ok('Koha::Cache');
use_ok('Koha::Cache::Object');
+ use_ok('Koha::Cache::Memory::Lite');
use_ok('C4::Context');
}
is_deeply( $cache->get_from_cache('test_deep_copy_hash'), { another => 'hashref' }, 'A hash will not be deep copied if the unsafe flag is set');
}
+subtest 'Koha::Cache::Memory::Lite' => sub {
+ plan tests => 6;
+ my $memory_cache = Koha::Cache::Memory::Lite->get_instance();
+
+ # test fetching an item that isnt in the cache
+ is( $memory_cache->get_from_cache("not in here"),
+ undef, "fetching item NOT in cache" );
+
+ # test fetching a valid item from cache
+ $memory_cache->set_in_cache( "clear_me", "I AM MORE DATA" );
+ $memory_cache->set_in_cache( "dont_clear_me", "I AM MORE DATA22" );
+ ; # overly large expiry time, clear below
+ is(
+ $memory_cache->get_from_cache("clear_me"),
+ "I AM MORE DATA",
+ "fetching valid item from cache"
+ );
+
+ # test clearing from cache
+ $memory_cache->clear_from_cache("clear_me");
+ is( $memory_cache->get_from_cache("clear_me"),
+ undef, "fetching cleared item from cache" );
+ is(
+ $memory_cache->get_from_cache("dont_clear_me"),
+ "I AM MORE DATA22",
+ "fetching valid item from cache (after clearing another item)"
+ );
+
+ #test flushing from cache
+ $memory_cache->set_in_cache( "flush_me", "testing 1 data" );
+ $memory_cache->flush;
+ is( $memory_cache->get_from_cache("flush_me"),
+ undef, "fetching flushed item from cache" );
+ is( $memory_cache->get_from_cache("dont_clear_me"),
+ undef, "fetching flushed item from cache" );
+};
+
END {
SKIP: {
$ENV{ MEMCACHED_NAMESPACE } = 'unit_tests';