[Koha-patches] [PATCH] Performance enhancing

[Henri-Damien LAURENT]

C4::Context.pm
Loads all systempreferences at once
And uses Memcached to cache them

C4::Languages
Using List::MoreUtils
Memcaching get_langage_description

Signed-off-by: Henri-Damien LAURENT <henridamien.laurent at biblibre.com>
---
 C4/Context.pm   |   27 ++++++++++++++++++++++-----
 C4/Languages.pm |   39 ++++++++++++++++++++-------------------
 2 files changed, 42 insertions(+), 24 deletions(-)

diff --git a/C4/Context.pm b/C4/Context.pm
index 926c1a5..5bd16d5 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -20,6 +20,21 @@ use strict;
 use warnings;
 use vars qw($VERSION $AUTOLOAD $context @context_stack);
 
+eval {
+    my $servers = C4::Context->config('memcached_servers');
+    if ($servers) {
+        require Memoize::Memcached;
+        import Memoize::Memcached qw(memoize_memcached);
+ 
+        my $memcached = {
+            servers    => [ $servers ],
+            key_prefix => C4::Context->config('memcached_namespace') || 'koha',
+        };
+
+        memoize_memcached('preference', memcached => $memcached, expire_time => 600000); #cache for 10 minutes
+    }
+};
+
 BEGIN {
 	if ($ENV{'HTTP_USER_AGENT'})	{
 		require CGI::Carp;
@@ -79,7 +94,8 @@ BEGIN {
 		}
     }  	# else there is no browser to send fatals to!
 	$VERSION = '3.00.00.036';
-}
+};
+
 
 use DBI;
 use ZOOM;
@@ -88,6 +104,7 @@ use C4::Boolean;
 use C4::Debug;
 use POSIX ();
 
+
 =head1 NAME
 
 C4::Context - Maintain and manipulate the context of a Koha script
@@ -477,12 +494,12 @@ sub preference {
 
     # Look up systempreferences.variable==$var
     my $sql = <<'END_SQL';
-        SELECT    value
+        SELECT    variable, value
         FROM    systempreferences
-        WHERE    variable=?
-        LIMIT    1
 END_SQL
-    $sysprefs{$var} = $dbh->selectrow_array( $sql, {}, $var );
+    my $sysprefs_arrayref;
+    $sysprefs_arrayref = $dbh->selectcol_arrayref( $sql, { Columns=>[1,2] });
+    %sysprefs= @$sysprefs_arrayref;
     return $sysprefs{$var};
 }
 
diff --git a/C4/Languages.pm b/C4/Languages.pm
index 21dd6e8..c09f37b 100644
--- a/C4/Languages.pm
+++ b/C4/Languages.pm
@@ -20,9 +20,10 @@ package C4::Languages;
 
 
 use strict; 
-#use warnings;   #FIXME: turn off warnings before release
+#use warnings;   #FIXME: turn on warnings before release
 use Carp;
 use C4::Context;
+use List::MoreUtils qw/any/;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
 eval {
@@ -36,9 +37,10 @@ eval {
             key_prefix => C4::Context->config('memcached_namespace') || 'koha',
         };
 
-        memoize_memcached('getTranslatedLanguages', memcached => $memcached, expire_time => 600); #cache for 10 minutes
-        memoize_memcached('getFrameworkLanguages' , memcached => $memcached, expire_time => 600);
-        memoize_memcached('getAllLanguages',        memcached => $memcached, expire_time => 600);
+        memoize_memcached('getTranslatedLanguages', memcached => $memcached, expire_time => 600000); #cache for 10 minutes
+        memoize_memcached('getFrameworkLanguages' , memcached => $memcached, expire_time => 600000);
+        memoize_memcached('getAllLanguages',        memcached => $memcached, expire_time => 600000);
+        memoize_memcached('language_get_description',        memcached => $memcached, expire_time => 600000);
     }
 };
 
@@ -92,17 +94,11 @@ sub getFrameworkLanguages {
     closedir MYDIR;
 
     # pull out all data for the dir names that exist
-    for my $dirname (@listdir) {
-        for my $language_set (@$all_languages) {
-
-            if ($dirname eq $language_set->{language_code}) {
-                push @languages, {
-                    'language_code'=>$dirname, 
-                    'language_description'=>$language_set->{language_description}, 
-                    'native_descrition'=>$language_set->{language_native_description} }
-            }
-        }
-    }
+    my @languages=grep {
+                    my $language=$_; 
+                    any {$language->{languagecode} eq $_
+                        } @listdir
+                  } @$all_languages;
     return \@languages;
 }
 
@@ -128,7 +124,8 @@ sub getTranslatedLanguages {
     my @enabled_languages;
  
     if ($interface && $interface eq 'opac' ) {
-        @enabled_languages = split ",", C4::Context->preference('opaclanguages');
+        my $languages= C4::Context->preference('opaclanguage') ||'en';
+        @enabled_languages = split ",", $languages;
         $htdocs = C4::Context->config('opachtdocs');
         if ( $theme and -d "$htdocs/$theme" ) {
             (@languages) = _get_language_dirs($htdocs,$theme);
@@ -140,7 +137,8 @@ sub getTranslatedLanguages {
         }
     }
     elsif ($interface && $interface eq 'intranet' ) {
-        @enabled_languages = split ",", C4::Context->preference('language');
+        my $languages= C4::Context->preference('language') ||'en';
+        @enabled_languages = split ",", $languages;
         $htdocs = C4::Context->config('intrahtdocs');
         if ( $theme and -d "$htdocs/$theme" ) {
             @languages = _get_language_dirs($htdocs,$theme);
@@ -152,7 +150,8 @@ sub getTranslatedLanguages {
         }
     }
     else {
-        @enabled_languages = split ",", C4::Context->preference('opaclanguages');
+        my $languages= C4::Context->preference('opaclanguage') ||'en';
+        @enabled_languages = split ",", $languages;
         my $htdocs = C4::Context->config('intrahtdocs');
         foreach my $theme ( _get_themes('intranet') ) {
             push @languages, _get_language_dirs($htdocs,$theme);
@@ -182,8 +181,10 @@ Returns a reference to an array of hashes:
 
 =cut
 
+my @languages_loop;
+
 sub getAllLanguages {
-    my @languages_loop;
+    return   \@languages_loop if scalar(@languages_loop);
     my $dbh=C4::Context->dbh;
     my $current_language = shift || 'en';
     my $sth = $dbh->prepare('SELECT * FROM language_subtag_registry WHERE type=\'language\'');
-- 
1.6.3.3