X-Git-Url: http://koha-dev.rot13.org:8081/gitweb/?a=blobdiff_plain;f=Koha%2FI18N.pm;h=464911cb2dcc7da5ce2f360c3ca4a2336bca9db3;hb=241cbea6912d0ecc0232e57f0b09d0a72a9926e4;hp=c1dffed2a4bc40a080fdfed4568d997d82ddd965;hpb=fe32727fc55823ab1a3edba70597b89856cd0ea3;p=srvgit diff --git a/Koha/I18N.pm b/Koha/I18N.pm index c1dffed2a4..464911cb2d 100644 --- a/Koha/I18N.pm +++ b/Koha/I18N.pm @@ -1,52 +1,225 @@ package Koha::I18N; -# Copyright 2012 BibLibre -# # This file is part of Koha. # -# Koha is free software; you can redistribute it and/or modify it under the -# terms of the GNU General Public License as published by the Free Software -# Foundation; either version 2 of the License, or (at your option) any later -# version. +# Copyright 2012-2014 BibLibre +# +# Koha is free software; you can redistribute it and/or modify it +# under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. # -# Koha is distributed in the hope that it will be useful, but WITHOUT ANY -# WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR -# A PARTICULAR PURPOSE. See the GNU General Public License for more details. +# Koha is distributed in the hope that it will be useful, but +# WITHOUT ANY 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., -# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. +# You should have received a copy of the GNU General Public License +# along with Koha; if not, see . use Modern::Perl; -use base qw(Locale::Maketext); -use C4::Templates; +use C4::Languages; use C4::Context; -use Locale::Maketext::Lexicon { - 'en' => ['Auto'], - '*' => [ - Gettext => - C4::Context->config('intranetdir') - . '/misc/translator/po/*-messages.po' - ], - '_AUTO' => 1, -}; - -sub get_handle_from_context { - my ($class, $cgi, $interface) = @_; - - my $lh; - my $lang = C4::Templates::getlanguage($cgi, $interface); - if ($lang) { - $lh = $class->get_handle($lang) - or die "No language handle for '$lang'"; - } else { - $lh = $class->get_handle() - or die "Can't get a language handle"; +use Encode; +use List::Util qw( first ); +use Locale::Messages qw( + bindtextdomain + gettext + LC_MESSAGES + ngettext + npgettext + pgettext + textdomain +); +use POSIX qw(); +use Koha::Cache::Memory::Lite; + +use parent 'Exporter'; +our @EXPORT = qw( + __ + __x + __n + __nx + __xn + __p + __px + __np + __npx + N__ + N__n + N__p + N__np +); + +our $textdomain = 'Koha'; + +sub init { + my $cache = Koha::Cache::Memory::Lite->get_instance(); + my $cache_key = 'i18n:initialized'; + unless ($cache->get_from_cache($cache_key)) { + my @system_locales = grep { chomp; not (/^C/ || $_ eq 'POSIX') } qx/locale -a/; + if (@system_locales) { + # LANG needs to be set to a valid locale, + # otherwise LANGUAGE is ignored + $ENV{LANG} = $system_locales[0]; + POSIX::setlocale(LC_MESSAGES, ''); + + my $langtag = C4::Languages::getlanguage; + my @subtags = split /-/, $langtag; + my ($language, $region) = @subtags; + if ($region && length $region == 4) { + $region = $subtags[2]; + } + my $locale = $language; + if ($region) { + $locale .= '_' . $region; + } + + $ENV{LANGUAGE} = $locale; + $ENV{OUTPUT_CHARSET} = 'UTF-8'; + + my $directory = _base_directory(); + textdomain($textdomain); + bindtextdomain($textdomain, $directory); + } else { + warn "No locale installed. Localization cannot work and is therefore disabled"; + } + + $cache->set_in_cache($cache_key, 1); } +} + +sub __ { + my ($msgid) = @_; + + $msgid = Encode::encode_utf8($msgid); + + return _gettext(\&gettext, [ $msgid ]); +} + +sub __x { + my ($msgid, %vars) = @_; + + $msgid = Encode::encode_utf8($msgid); + + return _gettext(\&gettext, [ $msgid ], %vars); +} + +sub __n { + my ($msgid, $msgid_plural, $count) = @_; + + $msgid = Encode::encode_utf8($msgid); + $msgid_plural = Encode::encode_utf8($msgid_plural); + + return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ]); +} + +sub __nx { + my ($msgid, $msgid_plural, $count, %vars) = @_; + + $msgid = Encode::encode_utf8($msgid); + $msgid_plural = Encode::encode_utf8($msgid_plural); + + return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ], %vars); +} + +sub __xn { + return __nx(@_); +} + +sub __p { + my ($msgctxt, $msgid) = @_; + + $msgctxt = Encode::encode_utf8($msgctxt); + $msgid = Encode::encode_utf8($msgid); + + return _gettext(\&pgettext, [ $msgctxt, $msgid ]); +} + +sub __px { + my ($msgctxt, $msgid, %vars) = @_; + + $msgctxt = Encode::encode_utf8($msgctxt); + $msgid = Encode::encode_utf8($msgid); + + return _gettext(\&pgettext, [ $msgctxt, $msgid ], %vars); +} + +sub __np { + my ($msgctxt, $msgid, $msgid_plural, $count) = @_; + + $msgctxt = Encode::encode_utf8($msgctxt); + $msgid = Encode::encode_utf8($msgid); + $msgid_plural = Encode::encode_utf8($msgid_plural); + + return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count ]); +} + +sub __npx { + my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_; + + $msgctxt = Encode::encode_utf8($msgctxt); + $msgid = Encode::encode_utf8($msgid); + $msgid_plural = Encode::encode_utf8($msgid_plural); + + return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count], %vars); +} + +sub N__ { + return @_; +} + +sub N__n { + return @_; +} + +sub N__p { + return @_; +} + +sub N__np { + return @_; +} + +sub _base_directory { + # Directory structure is not the same for dev and standard installs + # Here we test the existence of several directories and use the first that exist + # FIXME There has to be a better solution + my @dirs = ( + C4::Context->config('intranetdir') . '/misc/translator/po', + C4::Context->config('intranetdir') . '/../../misc/translator/po', + ); + my $dir = first { -d } @dirs; + + unless ($dir) { + die "The PO directory has not been found. There is a problem in your Koha installation."; + } + + return $dir; +} + +sub _gettext { + my ($sub, $args, %vars) = @_; + + init(); + + my $text = Encode::decode_utf8($sub->(@$args)); + if (%vars) { + $text = _expand($text, %vars); + } + + return $text; +} + +sub _expand { + my ($text, %vars) = @_; + + my $re = join '|', map { quotemeta $_ } keys %vars; + $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge; - return $lh; + return $text; } 1;