From f01a07a25e0503d9dbed3a4226cb51a155bcacd4 Mon Sep 17 00:00:00 2001 From: Jonathan Druart Date: Mon, 9 May 2016 17:27:51 +0100 Subject: [PATCH] Bug 16088: Introduce Koha::Cache::Memory::Lite to cache the language 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 Signed-off-by: Jesse Weaver Signed-off-by: Brendan Gallagher --- C4/Languages.pm | 30 ++++++++++------ C4/Templates.pm | 14 ++++---- Koha/Cache/Memory/Lite.pm | 72 +++++++++++++++++++++++++++++++++++++ debian/templates/plack.psgi | 3 ++ misc/plack/koha.psgi | 2 ++ t/Cache.t | 40 ++++++++++++++++++++- 6 files changed, 144 insertions(+), 17 deletions(-) create mode 100644 Koha/Cache/Memory/Lite.pm diff --git a/C4/Languages.pm b/C4/Languages.pm index affe96c2f7..38e87b6ec6 100644 --- a/C4/Languages.pm +++ b/C4/Languages.pm @@ -26,6 +26,7 @@ use Carp; use CGI; use List::MoreUtils qw( any ); use C4::Context; +use Koha::Cache::Memory::Lite; use vars qw(@ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG); eval { @@ -569,6 +570,13 @@ sub accept_language { 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' ); @@ -584,14 +592,14 @@ sub getlanguage { } # 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 @@ -601,16 +609,18 @@ sub getlanguage { } # 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; diff --git a/C4/Templates.pm b/C4/Templates.pm index b3d7edf9a9..eebff1102d 100644 --- a/C4/Templates.pm +++ b/C4/Templates.pm @@ -36,6 +36,8 @@ use C4::Languages qw(getTranslatedLanguages get_bidi regex_lang_subtags language use C4::Context; +use Koha::Cache::Memory::Lite; + __PACKAGE__->mk_accessors(qw( theme activethemes preferredtheme lang filename htdocs interface vars)); @@ -273,12 +275,12 @@ sub themelanguage { 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 diff --git a/Koha/Cache/Memory/Lite.pm b/Koha/Cache/Memory/Lite.pm new file mode 100644 index 0000000000..74e4115e68 --- /dev/null +++ b/Koha/Cache/Memory/Lite.pm @@ -0,0 +1,72 @@ +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 . + +=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; diff --git a/debian/templates/plack.psgi b/debian/templates/plack.psgi index 995fa7213c..af95a5aea0 100644 --- a/debian/templates/plack.psgi +++ b/debian/templates/plack.psgi @@ -34,6 +34,8 @@ use C4::Languages; use C4::Letters; use C4::Members; use C4::XSLT; +use Koha::Cache; +use Koha::Cache::Memory::Lite; use Koha::Database; use Koha::DateUtils; @@ -45,6 +47,7 @@ use CGI qw(-utf8 ); # we will loose -utf8 under plack, otherwise my $q = $old_new->( @_ ); $CGI::PARAM_UTF8 = 1; Koha::Cache->flush_L1_cache(); + Koha::Cache::Memory::Lite->flush(); return $q; }; } diff --git a/misc/plack/koha.psgi b/misc/plack/koha.psgi index 7f3ea27ebb..8a2ffd3292 100644 --- a/misc/plack/koha.psgi +++ b/misc/plack/koha.psgi @@ -13,6 +13,7 @@ use CGI qw(-utf8 ); # we will lose -utf8 under plack my $q = $old_new->( @_ ); $CGI::PARAM_UTF8 = 1; Koha::Cache->flush_L1_cache(); + Koha::Cache::Memory::Lite->flush(); return $q; }; } @@ -46,6 +47,7 @@ use C4::Branch; use C4::Category; use Koha::DateUtils; use Koha::Cache; +use Koha::Cache::Memory::Lite; =for preload use C4::Tags; # FIXME =cut diff --git a/t/Cache.t b/t/Cache.t index 101f723935..cc8096b3cb 100644 --- a/t/Cache.t +++ b/t/Cache.t @@ -17,7 +17,7 @@ use Modern::Perl; -use Test::More tests => 41; +use Test::More tests => 43; use Test::Warn; my $destructorcount = 0; @@ -25,6 +25,7 @@ my $destructorcount = 0; BEGIN { use_ok('Koha::Cache'); use_ok('Koha::Cache::Object'); + use_ok('Koha::Cache::Memory::Lite'); use_ok('C4::Context'); } @@ -221,6 +222,43 @@ SKIP: { 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'; -- 2.39.5