X-Git-Url: http://git.rot13.org/?a=blobdiff_plain;f=C4%2FLanguages.pm;h=b31812e0a26aa59ccdea23861e047c4aa3df61aa;hb=b2155fc483f09b34c4a6ba92256f2732152bb1d5;hp=8eb66938253eabd8d39465a25ebe0b486a0a933c;hpb=802b13e5f5e79a689c64b6826d229958b2bb14f0;p=koha.git diff --git a/C4/Languages.pm b/C4/Languages.pm index 8eb6693825..b31812e0a2 100644 --- a/C4/Languages.pm +++ b/C4/Languages.pm @@ -2,7 +2,7 @@ package C4::Languages; # Copyright 2006 (C) LibLime # Joshua Ferraro -# +# 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 @@ -104,39 +128,38 @@ Returns a reference to an array of hashes: =cut sub getTranslatedLanguages { - my ($interface, $theme, $current_language) = @_; + my ($interface, $theme, $current_language, $which) = @_; my $htdocs; my $all_languages = getAllLanguages(); my @languages; - my $lang; - + 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); - return _build_languages_arrayref($all_languages,\@languages,$current_language); } else { for my $theme ( _get_themes('opac') ) { push @languages, _get_language_dirs($htdocs,$theme); } - return _build_languages_arrayref($all_languages,\@languages,$current_language); } } 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); - return _build_languages_arrayref($all_languages,\@languages,$current_language); } else { foreach my $theme ( _get_themes('intranet') ) { push @languages, _get_language_dirs($htdocs,$theme); } - return _build_languages_arrayref($all_languages,\@languages,$current_language); } } else { + @enabled_languages = split ",", C4::Context->preference('opaclanguages'); my $htdocs = C4::Context->config('intrahtdocs'); foreach my $theme ( _get_themes('intranet') ) { push @languages, _get_language_dirs($htdocs,$theme); @@ -145,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); + my %seen; + $seen{$_}++ for @languages; + @languages = keys %seen; } + return _build_languages_arrayref($all_languages,\@languages,$current_language,\@enabled_languages); } =head2 getAllLanguages @@ -154,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"; @@ -166,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; } @@ -231,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); @@ -246,9 +287,11 @@ FIXME: this could be rewritten and simplified using map =cut sub _build_languages_arrayref { - my ($all_languages,$translated_languages,$current_language) = @_; + my ($all_languages,$translated_languages,$current_language,$enabled_languages) = @_; 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; @@ -256,9 +299,14 @@ sub _build_languages_arrayref { my $current_language_regex = regex_lang_subtags($current_language); # Loop through the translated languages for my $translated_language (@translated_languages) { - # 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; @@ -272,6 +320,13 @@ sub _build_languages_arrayref { } # $key is a language subtag like 'en' 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}, @@ -280,6 +335,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, }; } return \@languages_loop; @@ -405,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); @@ -432,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; } }