3 # This file is part of Koha.
5 # Copyright 2012-2014 BibLibre
7 # Koha is free software; you can redistribute it and/or modify it
8 # under the terms of the GNU General Public License as published by
9 # the Free Software Foundation; either version 3 of the License, or
10 # (at your option) any later version.
12 # Koha is distributed in the hope that it will be useful, but
13 # WITHOUT ANY WARRANTY; without even the implied warranty of
14 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 # GNU General Public License for more details.
17 # You should have received a copy of the GNU General Public License
18 # along with Koha; if not, see <http://www.gnu.org/licenses>.
27 use List::Util qw( first );
28 use Locale::Messages qw(:locale_h LC_MESSAGES);
29 use POSIX qw( setlocale );
30 use Koha::Cache::Memory::Lite;
32 use parent 'Exporter';
49 our $textdomain = 'Koha';
52 my $cache = Koha::Cache::Memory::Lite->get_instance();
53 my $cache_key = 'i18n:initialized';
54 unless ($cache->get_from_cache($cache_key)) {
55 my @system_locales = grep { chomp; not (/^C/ || $_ eq 'POSIX') } qx/locale -a/;
56 if (@system_locales) {
57 # LANG needs to be set to a valid locale,
58 # otherwise LANGUAGE is ignored
59 $ENV{LANG} = $system_locales[0];
60 POSIX::setlocale(LC_MESSAGES, '');
62 my $langtag = C4::Languages::getlanguage;
63 my @subtags = split /-/, $langtag;
64 my ($language, $region) = @subtags;
65 if ($region && length $region == 4) {
66 $region = $subtags[2];
68 my $locale = $language;
70 $locale .= '_' . $region;
73 $ENV{LANGUAGE} = $locale;
74 $ENV{OUTPUT_CHARSET} = 'UTF-8';
76 my $directory = _base_directory();
77 textdomain($textdomain);
78 bindtextdomain($textdomain, $directory);
80 warn "No locale installed. Localization cannot work and is therefore disabled";
83 $cache->set_in_cache($cache_key, 1);
90 $msgid = Encode::encode_utf8($msgid);
92 return _gettext(\&gettext, [ $msgid ]);
96 my ($msgid, %vars) = @_;
98 $msgid = Encode::encode_utf8($msgid);
100 return _gettext(\&gettext, [ $msgid ], %vars);
104 my ($msgid, $msgid_plural, $count) = @_;
106 $msgid = Encode::encode_utf8($msgid);
107 $msgid_plural = Encode::encode_utf8($msgid_plural);
109 return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ]);
113 my ($msgid, $msgid_plural, $count, %vars) = @_;
115 $msgid = Encode::encode_utf8($msgid);
116 $msgid_plural = Encode::encode_utf8($msgid_plural);
118 return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ], %vars);
126 my ($msgctxt, $msgid) = @_;
128 $msgctxt = Encode::encode_utf8($msgctxt);
129 $msgid = Encode::encode_utf8($msgid);
131 return _gettext(\&pgettext, [ $msgctxt, $msgid ]);
135 my ($msgctxt, $msgid, %vars) = @_;
137 $msgctxt = Encode::encode_utf8($msgctxt);
138 $msgid = Encode::encode_utf8($msgid);
140 return _gettext(\&pgettext, [ $msgctxt, $msgid ], %vars);
144 my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
146 $msgctxt = Encode::encode_utf8($msgctxt);
147 $msgid = Encode::encode_utf8($msgid);
148 $msgid_plural = Encode::encode_utf8($msgid_plural);
150 return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count ]);
154 my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
156 $msgctxt = Encode::encode_utf8($msgctxt);
157 $msgid = Encode::encode_utf8($msgid);
158 $msgid_plural = Encode::encode_utf8($msgid_plural);
160 return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count], %vars);
179 sub _base_directory {
180 # Directory structure is not the same for dev and standard installs
181 # Here we test the existence of several directories and use the first that exist
182 # FIXME There has to be a better solution
184 C4::Context->config('intranetdir') . '/misc/translator/po',
185 C4::Context->config('intranetdir') . '/../../misc/translator/po',
187 my $dir = first { -d } @dirs;
190 die "The PO directory has not been found. There is a problem in your Koha installation.";
197 my ($sub, $args, %vars) = @_;
201 my $text = Encode::decode_utf8($sub->(@$args));
203 $text = _expand($text, %vars);
210 my ($text, %vars) = @_;
212 my $re = join '|', map { quotemeta $_ } keys %vars;
213 $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;