[Koha-patches] [PATCH] Bug 6000 : Performance enhancing

Tomas Cohen Arazi tomascohen at gmail.com
Wed Jan 4 17:27:15 CET 2012


From: Henri-Damien LAURENT <henridamien.laurent at biblibre.com>

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

C4::Languages
Using List::MoreUtils
Memcaching get_langage_description

Bug 6000 : Follow up Performance enhancing : C4/Languages.pm

removing a call unused to getAllLanguages
Doing better job at enabled languages

Bug 6000: Rebase against origin/master + 6193
---
 C4/Context.pm   |   20 ++++++++---
 C4/Languages.pm |   96 +++++++++++++++++++-----------------------------------
 2 files changed, 49 insertions(+), 67 deletions(-)

diff --git a/C4/Context.pm b/C4/Context.pm
index d6c2e9a..3cae674 100644
--- a/C4/Context.pm
+++ b/C4/Context.pm
@@ -92,10 +92,19 @@ BEGIN {
 		  });
         # Verify memcached available (set a variable and test the output)
 	$ismemcached = $memcached->set('ismemcached','1');
+        if ($ismemcached) {
+          require Memoize::Memcached;
+          import Memoize::Memcached qw(memoize_memcached);
+
+          memoize_memcached('preference',
+                            memcached => $memcached,
+                            expire_time => 600000); #cache for 10 minutes
+        }
     }
 
 	$VERSION = '3.00.00.036';
-}
+};
+
 
 use DBI;
 use ZOOM;
@@ -104,6 +113,7 @@ use C4::Boolean;
 use C4::Debug;
 use POSIX ();
 
+
 =head1 NAME
 
 C4::Context - Maintain and manipulate the context of a Koha script
@@ -533,12 +543,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 0cc288e..944f695 100644
--- a/C4/Languages.pm
+++ b/C4/Languages.pm
@@ -23,6 +23,7 @@ use strict;
 #use warnings; FIXME - Bug 2505
 use Carp;
 use C4::Context;
+use List::MoreUtils qw/any uniq/;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
 eval {
@@ -33,6 +34,7 @@ eval {
         memoize_memcached('getTranslatedLanguages', memcached => C4::Context->memcached, expire_time => 600); #cache for 10 minutes
         memoize_memcached('getFrameworkLanguages' , memcached => C4::Context->memcached, expire_time => 600);
         memoize_memcached('getAllLanguages',        memcached => C4::Context->memcached, expire_time => 600);
+        memoize_memcached('language_get_description',        memcached => C4::Context->memcached, expire_time => 600000);
     }
 };
 
@@ -79,8 +81,7 @@ Returns a reference to an array of hashes:
 sub getFrameworkLanguages {
     # get a hash with all language codes, names, and locale names
     my $all_languages = getAllLanguages();
-    my @languages;
-    
+        
     # find the available directory names
     my $dir=C4::Context->config('intranetdir')."/installer/data/";
     opendir (MYDIR,$dir);
@@ -88,17 +89,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;
 }
 
@@ -119,49 +114,35 @@ Returns a reference to an array of hashes:
 sub getTranslatedLanguages {
     my ($interface, $theme, $current_language, $which) = @_;
     my $htdocs;
-    my $all_languages = getAllLanguages();
     my @languages;
     my @enabled_languages;
  
-    if ($interface && $interface eq 'opac' ) {
-        @enabled_languages = split ",", C4::Context->preference('opaclanguages');
-        $htdocs = C4::Context->config('opachtdocs');
-        if ( $theme and -d "$htdocs/$theme" ) {
-            (@languages) = _get_language_dirs($htdocs,$theme);
-        }
-        else {
-            for my $theme ( _get_themes('opac') ) {
-                push @languages, _get_language_dirs($htdocs,$theme);
-            }
-        }
+    my ($preference,$config);
+    if ($interface && $interface eq 'intranet' ) {
+        $preference="language";
+        $config='intrahtdocs';
     }
-    elsif ($interface && $interface eq 'intranet' ) {
-        @enabled_languages = split ",", C4::Context->preference('language');
-        $htdocs = C4::Context->config('intrahtdocs');
-        if ( $theme and -d "$htdocs/$theme" ) {
-            @languages = _get_language_dirs($htdocs,$theme);
-        }
-        else {
-            foreach my $theme ( _get_themes('intranet') ) {
-                push @languages, _get_language_dirs($htdocs,$theme);
-            }
-        }
+    else {
+        $preference="opaclanguages";
+        $config='opachtdocs';
+        $interface ||='opac';
+
+    }
+
+    my $languages= C4::Context->preference($preference) ||'en';
+    @enabled_languages = split ",", $languages;
+    $htdocs = C4::Context->config($config);
+    if ( $theme and -d "$htdocs/$theme" ) {
+        (@languages) = _get_language_dirs($htdocs,$theme);
     }
     else {
-        @enabled_languages = split ",", C4::Context->preference('opaclanguages');
-        my $htdocs = C4::Context->config('intrahtdocs');
-        foreach my $theme ( _get_themes('intranet') ) {
+        for my $theme ( _get_themes($interface) ) {
             push @languages, _get_language_dirs($htdocs,$theme);
         }
-        $htdocs = C4::Context->config('opachtdocs');
-        foreach my $theme ( _get_themes('opac') ) {
-            push @languages, _get_language_dirs($htdocs,$theme);
-        }
-        my %seen;
-        $seen{$_}++ for @languages;
-        @languages = keys %seen;
+        @languages=uniq @languages;
     }
-    return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
+    @enabled_languages=grep{my $enabled_language=$_;any{$_ eq $enabled_language}@languages}@enabled_languages;
+    return _build_languages_arrayref(\@enabled_languages,$current_language);
 }
 
 =head2 getAllLanguages
@@ -178,8 +159,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\'');
@@ -276,10 +259,9 @@ FIXME: this could be rewritten and simplified using map
 =cut
 
 sub _build_languages_arrayref {
-        my ($all_languages,$translated_languages,$current_language,$enabled_languages) = @_;
+        my ($translated_languages,$current_language) = @_;
         my @translated_languages = @$translated_languages;
         my @languages_loop; # the final reference to an array of hashrefs
-        my @enabled_languages = @$enabled_languages;
         # how many languages are enabled, if one, take note, some contexts won't need to display it
         my %seen_languages; # the language tags we've seen
         my %found_languages;
@@ -291,15 +273,10 @@ sub _build_languages_arrayref {
             # separate the language string into its subtag types
             my $language_subtags_hashref = regex_lang_subtags($translated_language);
 
-            # is this language string 'enabled'?
-            for my $enabled_language (@enabled_languages) {
-                #warn "Checking out if $translated_language eq $enabled_language";
-                $language_subtags_hashref->{'enabled'} = 1 if $translated_language eq $enabled_language;
-            }
-            
             # group this language, key by langtag
             $language_subtags_hashref->{'sublanguage_current'} = 1 if $translated_language eq $current_language;
             $language_subtags_hashref->{'rfc4646_subtag'} = $translated_language;
+            $language_subtags_hashref->{'enabled'} = 1;
             $language_subtags_hashref->{'native_description'} = language_get_description($language_subtags_hashref->{language},$language_subtags_hashref->{language},'language');
             $language_subtags_hashref->{'script_description'} = language_get_description($language_subtags_hashref->{script},$language_subtags_hashref->{'language'},'script');
             $language_subtags_hashref->{'region_description'} = language_get_description($language_subtags_hashref->{region},$language_subtags_hashref->{'language'},'region');
@@ -311,11 +288,6 @@ sub _build_languages_arrayref {
         while( my ($key, $value) = each %$language_groups) {
 
             # is this language group enabled? are any of the languages within it enabled?
-            my $enabled;
-            for my $enabled_language (@enabled_languages) {
-                my $regex_enabled_language = regex_lang_subtags($enabled_language);
-                $enabled = 1 if $key eq $regex_enabled_language->{language};
-            }
             push @languages_loop,  {
                             # this is only use if there is one
                             rfc4646_subtag => @$value[0]->{rfc4646_subtag},
@@ -324,7 +296,7 @@ sub _build_languages_arrayref {
                             sublanguages_loop => $value,
                             plural => $track_language_groups->{$key} >1 ? 1 : 0,
                             current => $current_language_regex->{language} eq $key ? 1 : 0,
-                            group_enabled => $enabled,
+                            group_enabled=>1
                            };
         }
         return \@languages_loop;
-- 
1.7.5.4



More information about the Koha-patches mailing list