X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLanguages.pm;h=b31812e0a26aa59ccdea23861e047c4aa3df61aa;hb=b2155fc483f09b34c4a6ba92256f2732152bb1d5;hp=bc578f0f1413e7d6690fb9aaf06add9da6d1b41b;hpb=5bb6d117c54034d86c5006e54b5125b0e6fb086e;p=koha.git

diff --git a/C4/Languages.pm b/C4/Languages.pm
index bc578f0f14..b31812e0a2 100644
--- a/C4/Languages.pm
+++ b/C4/Languages.pm
@@ -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
@@ -94,7 +118,7 @@ sub getFrameworkLanguages {
 Returns a reference to an array of hashes:
 
  my $languages = getTranslatedLanguages();
- print "Available translated langauges:\n";
+ print "Available translated languages:\n";
  for my $language(@$trlanguages) {
     print "$language->{language_code}\n"; # language code in iso 639-2
     print "$language->{language_name}\n"; # language name in native script
@@ -108,7 +132,6 @@ sub getTranslatedLanguages {
     my $htdocs;
     my $all_languages = getAllLanguages();
     my @languages;
-    my $lang;
     my @enabled_languages;
  
     if ($interface && $interface eq 'opac' ) {
@@ -116,13 +139,11 @@ sub getTranslatedLanguages {
         $htdocs = C4::Context->config('opachtdocs');
         if ( $theme and -d "$htdocs/$theme" ) {
             (@languages) = _get_language_dirs($htdocs,$theme);
-            return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
         }
         else {
             for my $theme ( _get_themes('opac') ) {
                 push @languages, _get_language_dirs($htdocs,$theme);
             }
-            return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
         }
     }
     elsif ($interface && $interface eq 'intranet' ) {
@@ -130,13 +151,11 @@ sub getTranslatedLanguages {
         $htdocs = C4::Context->config('intrahtdocs');
         if ( $theme and -d "$htdocs/$theme" ) {
             @languages = _get_language_dirs($htdocs,$theme);
-            return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
         }
         else {
             foreach my $theme ( _get_themes('intranet') ) {
                 push @languages, _get_language_dirs($htdocs,$theme);
             }
-            return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
         }
     }
     else {
@@ -149,8 +168,11 @@ sub getTranslatedLanguages {
         foreach my $theme ( _get_themes('opac') ) {
             push @languages, _get_language_dirs($htdocs,$theme);
         }
-        return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
+        my %seen;
+        $seen{$_}++ for @languages;
+        @languages = keys %seen;
     }
+    return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages);
 }
 
 =head2 getAllLanguages
@@ -158,7 +180,7 @@ sub getTranslatedLanguages {
 Returns a reference to an array of hashes:
 
  my $alllanguages = getAllLanguages();
- print "Available translated langauges:\n";
+ print "Available translated languages:\n";
  for my $language(@$alllanguages) {
     print "$language->{language_code}\n";
     print "$language->{language_name}\n";
@@ -170,20 +192,35 @@ Returns a reference to an array of hashes:
 sub getAllLanguages {
     my @languages_loop;
     my $dbh=C4::Context->dbh;
-    my $current_language = 'en';
+    my $current_language = shift || 'en';
     my $sth = $dbh->prepare('SELECT * FROM language_subtag_registry WHERE type=\'language\'');
     $sth->execute();
     while (my $language_subtag_registry = $sth->fetchrow_hashref) {
 
         # pull out all the script descriptions for each language
-        my $sth2= $dbh->prepare("SELECT * FROM language_descriptions LEFT JOIN language_rfc4646_to_iso639 on language_rfc4646_to_iso639.rfc4646_subtag = language_descriptions.subtag WHERE type='language' AND subtag =?");
-        $sth2->execute($language_subtag_registry->{subtag});
+        my $sth2= $dbh->prepare("SELECT * FROM language_descriptions LEFT JOIN language_rfc4646_to_iso639 on language_rfc4646_to_iso639.rfc4646_subtag = language_descriptions.subtag WHERE type='language' AND subtag =? AND language_descriptions.lang = ?");
+        $sth2->execute($language_subtag_registry->{subtag},$current_language);
+
+        my $sth3 = $dbh->prepare("SELECT description FROM language_descriptions WHERE type='language' AND subtag=? AND lang=?");
 
         # add the correct description info
         while (my $language_descriptions = $sth2->fetchrow_hashref) {
-        # fill in the ISO6329 code
-        $language_subtag_registry->{iso639_2_code} = $language_descriptions->{iso639_2_code};
-            $language_subtag_registry->{language_description} = $language_descriptions->{description};
+            $sth3->execute($language_subtag_registry->{subtag},$language_subtag_registry->{subtag});
+            my $native_description;
+            while (my $description = $sth3->fetchrow_hashref) {
+                $native_description = $description->{description};
+            }
+
+            # fill in the ISO6329 code
+            $language_subtag_registry->{iso639_2_code} = $language_descriptions->{iso639_2_code};
+            # fill in the native description of the language, as well as the current language's translation of that if it exists
+            if ($native_description) {
+                $language_subtag_registry->{language_description} = $native_description;
+                $language_subtag_registry->{language_description}.=" ($language_descriptions->{description})" if $language_descriptions->{description};
+            }
+            else {
+                $language_subtag_registry->{language_description} = $language_descriptions->{description};
+            }
         }
         push @languages_loop, $language_subtag_registry;
     }
@@ -235,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/;
+        next if $lang_string =~/img|images|famfam|sound|pdf/;
         push @lang_strings, $lang_string;
     }
         return (@lang_strings);
@@ -254,6 +291,7 @@ sub _build_languages_arrayref {
         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;
         my $language_groups;
@@ -423,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);
@@ -450,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;
         }
     }