Koha/I18N.pm

   1 package Koha::I18N;
   2
   3 # This file is part of Koha.
   4 #
   5 # Copyright 2012-2014 BibLibre
   6 #
   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.
  11 #
  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.
  16 #
  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>.
  19
  20 use Modern::Perl;
  21
  22 use C4::Languages;
  23 use C4::Context;
  24
  25 use Encode;
  26 use List::Util qw( first );
  27 use Locale::Messages qw(
  28     bindtextdomain
  29     gettext
  30     LC_MESSAGES
  31     ngettext
  32     npgettext
  33     pgettext
  34     textdomain
  35 );
  36 use POSIX qw();
  37 use Koha::Cache::Memory::Lite;
  38
  39 use parent 'Exporter';
  40 our @EXPORT = qw(
  41     __
  42     __x
  43     __n
  44     __nx
  45     __xn
  46     __p
  47     __px
  48     __np
  49     __npx
  50     N__
  51     N__n
  52     N__p
  53     N__np
  54 );
  55
  56 our $textdomain = 'Koha';
  57
  58 sub init {
  59     my $cache = Koha::Cache::Memory::Lite->get_instance();
  60     my $cache_key = 'i18n:initialized';
  61     unless ($cache->get_from_cache($cache_key)) {
  62         my @system_locales = grep { chomp; not (/^C/ || $_ eq 'POSIX') } qx/locale -a/;
  63         if (@system_locales) {
  64             # LANG needs to be set to a valid locale,
  65             # otherwise LANGUAGE is ignored
  66             $ENV{LANG} = $system_locales[0];
  67             POSIX::setlocale(LC_MESSAGES, '');
  68
  69             my $langtag = C4::Languages::getlanguage;
  70             my @subtags = split /-/, $langtag;
  71             my ($language, $region) = @subtags;
  72             if ($region && length $region == 4) {
  73                 $region = $subtags[2];
  74             }
  75             my $locale = $language;
  76             if ($region) {
  77                 $locale .= '_' . $region;
  78             }
  79
  80             $ENV{LANGUAGE} = $locale;
  81             $ENV{OUTPUT_CHARSET} = 'UTF-8';
  82
  83             my $directory = _base_directory();
  84             textdomain($textdomain);
  85             bindtextdomain($textdomain, $directory);
  86         } else {
  87             warn "No locale installed. Localization cannot work and is therefore disabled";
  88         }
  89
  90         $cache->set_in_cache($cache_key, 1);
  91     }
  92 }
  93
  94 sub __ {
  95     my ($msgid) = @_;
  96
  97     $msgid = Encode::encode_utf8($msgid);
  98
  99     return _gettext(\&gettext, [ $msgid ]);
 100 }
 101
 102 sub __x {
 103     my ($msgid, %vars) = @_;
 104
 105     $msgid = Encode::encode_utf8($msgid);
 106
 107     return _gettext(\&gettext, [ $msgid ], %vars);
 108 }
 109
 110 sub __n {
 111     my ($msgid, $msgid_plural, $count) = @_;
 112
 113     $msgid = Encode::encode_utf8($msgid);
 114     $msgid_plural = Encode::encode_utf8($msgid_plural);
 115
 116     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ]);
 117 }
 118
 119 sub __nx {
 120     my ($msgid, $msgid_plural, $count, %vars) = @_;
 121
 122     $msgid = Encode::encode_utf8($msgid);
 123     $msgid_plural = Encode::encode_utf8($msgid_plural);
 124
 125     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ], %vars);
 126 }
 127
 128 sub __xn {
 129     return __nx(@_);
 130 }
 131
 132 sub __p {
 133     my ($msgctxt, $msgid) = @_;
 134
 135     $msgctxt = Encode::encode_utf8($msgctxt);
 136     $msgid = Encode::encode_utf8($msgid);
 137
 138     return _gettext(\&pgettext, [ $msgctxt, $msgid ]);
 139 }
 140
 141 sub __px {
 142     my ($msgctxt, $msgid, %vars) = @_;
 143
 144     $msgctxt = Encode::encode_utf8($msgctxt);
 145     $msgid = Encode::encode_utf8($msgid);
 146
 147     return _gettext(\&pgettext, [ $msgctxt, $msgid ], %vars);
 148 }
 149
 150 sub __np {
 151     my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
 152
 153     $msgctxt = Encode::encode_utf8($msgctxt);
 154     $msgid = Encode::encode_utf8($msgid);
 155     $msgid_plural = Encode::encode_utf8($msgid_plural);
 156
 157     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count ]);
 158 }
 159
 160 sub __npx {
 161     my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
 162
 163     $msgctxt = Encode::encode_utf8($msgctxt);
 164     $msgid = Encode::encode_utf8($msgid);
 165     $msgid_plural = Encode::encode_utf8($msgid_plural);
 166
 167     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count], %vars);
 168 }
 169
 170 sub N__ {
 171     return $_[0];
 172 }
 173
 174 sub N__n {
 175     return $_[0];
 176 }
 177
 178 sub N__p {
 179     return $_[1];
 180 }
 181
 182 sub N__np {
 183     return $_[1];
 184 }
 185
 186 sub _base_directory {
 187     # Directory structure is not the same for dev and standard installs
 188     # Here we test the existence of several directories and use the first that exist
 189     # FIXME There has to be a better solution
 190     my @dirs = (
 191         C4::Context->config('intranetdir') . '/misc/translator/po',
 192         C4::Context->config('intranetdir') . '/../../misc/translator/po',
 193     );
 194     my $dir = first { -d } @dirs;
 195
 196     unless ($dir) {
 197         die "The PO directory has not been found. There is a problem in your Koha installation.";
 198     }
 199
 200     return $dir;
 201 }
 202
 203 sub _gettext {
 204     my ($sub, $args, %vars) = @_;
 205
 206     init();
 207
 208     my $text = Encode::decode_utf8($sub->(@$args));
 209     if (%vars) {
 210         $text = _expand($text, %vars);
 211     }
 212
 213     return $text;
 214 }
 215
 216 sub _expand {
 217     my ($text, %vars) = @_;
 218
 219     my $re = join '|', map { quotemeta $_ } keys %vars;
 220     $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;
 221
 222     return $text;
 223 }
 224
 225 1;