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 CGI;
  23 use C4::Languages;
  24 use C4::Context;
  25
  26 use Encode;
  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;
  31
  32 use parent 'Exporter';
  33 our @EXPORT = qw(
  34     __
  35     __x
  36     __n
  37     __nx
  38     __xn
  39     __p
  40     __px
  41     __np
  42     __npx
  43     N__
  44     N__n
  45     N__p
  46     N__np
  47 );
  48
  49 our $textdomain = 'Koha';
  50
  51 sub init {
  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, '');
  61
  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];
  67             }
  68             my $locale = $language;
  69             if ($region) {
  70                 $locale .= '_' . $region;
  71             }
  72
  73             $ENV{LANGUAGE} = $locale;
  74             $ENV{OUTPUT_CHARSET} = 'UTF-8';
  75
  76             my $directory = _base_directory();
  77             textdomain($textdomain);
  78             bindtextdomain($textdomain, $directory);
  79         } else {
  80             warn "No locale installed. Localization cannot work and is therefore disabled";
  81         }
  82
  83         $cache->set_in_cache($cache_key, 1);
  84     }
  85 }
  86
  87 sub __ {
  88     my ($msgid) = @_;
  89
  90     $msgid = Encode::encode_utf8($msgid);
  91
  92     return _gettext(\&gettext, [ $msgid ]);
  93 }
  94
  95 sub __x {
  96     my ($msgid, %vars) = @_;
  97
  98     $msgid = Encode::encode_utf8($msgid);
  99
 100     return _gettext(\&gettext, [ $msgid ], %vars);
 101 }
 102
 103 sub __n {
 104     my ($msgid, $msgid_plural, $count) = @_;
 105
 106     $msgid = Encode::encode_utf8($msgid);
 107     $msgid_plural = Encode::encode_utf8($msgid_plural);
 108
 109     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ]);
 110 }
 111
 112 sub __nx {
 113     my ($msgid, $msgid_plural, $count, %vars) = @_;
 114
 115     $msgid = Encode::encode_utf8($msgid);
 116     $msgid_plural = Encode::encode_utf8($msgid_plural);
 117
 118     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ], %vars);
 119 }
 120
 121 sub __xn {
 122     return __nx(@_);
 123 }
 124
 125 sub __p {
 126     my ($msgctxt, $msgid) = @_;
 127
 128     $msgctxt = Encode::encode_utf8($msgctxt);
 129     $msgid = Encode::encode_utf8($msgid);
 130
 131     return _gettext(\&pgettext, [ $msgctxt, $msgid ]);
 132 }
 133
 134 sub __px {
 135     my ($msgctxt, $msgid, %vars) = @_;
 136
 137     $msgctxt = Encode::encode_utf8($msgctxt);
 138     $msgid = Encode::encode_utf8($msgid);
 139
 140     return _gettext(\&pgettext, [ $msgctxt, $msgid ], %vars);
 141 }
 142
 143 sub __np {
 144     my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
 145
 146     $msgctxt = Encode::encode_utf8($msgctxt);
 147     $msgid = Encode::encode_utf8($msgid);
 148     $msgid_plural = Encode::encode_utf8($msgid_plural);
 149
 150     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count ]);
 151 }
 152
 153 sub __npx {
 154     my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
 155
 156     $msgctxt = Encode::encode_utf8($msgctxt);
 157     $msgid = Encode::encode_utf8($msgid);
 158     $msgid_plural = Encode::encode_utf8($msgid_plural);
 159
 160     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count], %vars);
 161 }
 162
 163 sub N__ {
 164     return @_;
 165 }
 166
 167 sub N__n {
 168     return @_;
 169 }
 170
 171 sub N__p {
 172     return @_;
 173 }
 174
 175 sub N__np {
 176     return @_;
 177 }
 178
 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
 183     my @dirs = (
 184         C4::Context->config('intranetdir') . '/misc/translator/po',
 185         C4::Context->config('intranetdir') . '/../../misc/translator/po',
 186     );
 187     my $dir = first { -d } @dirs;
 188
 189     unless ($dir) {
 190         die "The PO directory has not been found. There is a problem in your Koha installation.";
 191     }
 192
 193     return $dir;
 194 }
 195
 196 sub _gettext {
 197     my ($sub, $args, %vars) = @_;
 198
 199     init();
 200
 201     my $text = Encode::decode_utf8($sub->(@$args));
 202     if (%vars) {
 203         $text = _expand($text, %vars);
 204     }
 205
 206     return $text;
 207 }
 208
 209 sub _expand {
 210     my ($text, %vars) = @_;
 211
 212     my $re = join '|', map { quotemeta $_ } keys %vars;
 213     $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;
 214
 215     return $text;
 216 }
 217
 218 1;