# 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
# 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;
=head1 DESCRIPTION
+=cut
+
=head1 FUNCTIONS
=head2 getFrameworkLanguages
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);
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);
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;
}
}