use Memoize because Memcache::Memoize is slow for me
[koha.git] / C4 / Languages.pm
index 5795202..b31812e 100644 (file)
@@ -2,7 +2,7 @@ package C4::Languages;
 
 # Copyright 2006 (C) LibLime
 # Joshua Ferraro <jmf@liblime.com>
-#
+# Portions Copyright 2009 Chris Cormack and the Koha Dev Team
 # This file is part of Koha.
 #
 # Koha is free software; you can redistribute it and/or modify it under the
@@ -14,17 +14,39 @@ package C4::Languages;
 # 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, write to the Free Software Foundation, Inc., 59 Temple Place,
-# Suite 330, Boston, MA  02111-1307 USA
+# You should have received a copy of the GNU General Public License along
+# with Koha; if not, write to the Free Software Foundation, Inc.,
+# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 
 
 use strict; 
-#use warnings;   #FIXME: turn off warnings before release
+#use warnings; FIXME - Bug 2505
 use Carp;
 use C4::Context;
 use vars qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $DEBUG);
 
+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('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);
+    }
+};
+
+use Memoize;
+memoize('getTranslatedLanguages');
+memoize('getFrameworkLanguages');
+memoize('getAllLanguages');
+
 BEGIN {
     $VERSION = 3.00;
     require Exporter;
@@ -48,6 +70,8 @@ use C4::Languages;
 
 =head1 DESCRIPTION
 
+=cut
+
 =head1 FUNCTIONS
 
 =head2 getFrameworkLanguages
@@ -248,7 +272,7 @@ sub _get_language_dirs {
         next if $lang_string =~/css$/;
         next if $lang_string =~/CVS$/;
         next if $lang_string =~/\.txt$/i;     #Don't read the readme.txt !
-        next if $lang_string =~/img|images|famfam/;
+        next if $lang_string =~/img|images|famfam|sound|pdf/;
         push @lang_strings, $lang_string;
     }
         return (@lang_strings);
@@ -437,13 +461,11 @@ sub get_bidi {
 
 sub accept_language {
     # referenced http://search.cpan.org/src/CGILMORE/I18N-AcceptLanguage-1.04/lib/I18N/AcceptLanguage.pm
-    # FIXME: since this is only used in Output.pm as of Jan 8 2008, maybe it should be IN Output.pm
     my ($clientPreferences,$supportedLanguages) = @_;
     my @languages = ();
     if ($clientPreferences) {
         # There should be no whitespace anways, but a cleanliness/sanity check
         $clientPreferences =~ s/\s//g;
-
         # Prepare the list of client-acceptable languages
         foreach my $tag (split(/,/, $clientPreferences)) {
             my ($language, $quality) = split(/\;/, $tag);
@@ -464,10 +486,11 @@ sub accept_language {
     my %supportedLanguages = ();
     my %secondaryLanguages = ();
     foreach my $language (@$supportedLanguages) {
-        # warn "Language supported: " . $language->{language_code};
-        $supportedLanguages{lc($language->{language_code})} = $language->{language_code};
-        if ($language->{language_code} =~ /^([^-]+)-?/) {
-            $secondaryLanguages{lc($1)} = $language->{language_code};
+        # warn "Language supported: " . $language->{language};
+        my $subtag = $language->{rfc4646_subtag};
+        $supportedLanguages{lc($subtag)} = $subtag;
+        if ( $subtag =~ /^([^-]+)-?/ ) {
+            $secondaryLanguages{lc($1)} = $subtag;
         }
     }