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 Locale::Messages qw(:locale_h LC_MESSAGES);
  28 use POSIX qw( setlocale );
  29 use Koha::Cache::Memory::Lite;
  30
  31 use parent 'Exporter';
  32 our @EXPORT = qw(
  33     __
  34     __x
  35     __n
  36     __nx
  37     __xn
  38     __p
  39     __px
  40     __np
  41     __npx
  42     N__
  43     N__n
  44     N__p
  45     N__np
  46 );
  47
  48 our $textdomain = 'Koha';
  49
  50 sub init {
  51     my $cache = Koha::Cache::Memory::Lite->get_instance();
  52     my $cache_key = 'i18n:initialized';
  53     unless ($cache->get_from_cache($cache_key)) {
  54         my @system_locales = grep { chomp; not (/^C/ || $_ eq 'POSIX') } qx/locale -a/;
  55         if (@system_locales) {
  56             # LANG needs to be set to a valid locale,
  57             # otherwise LANGUAGE is ignored
  58             $ENV{LANG} = $system_locales[0];
  59             POSIX::setlocale(LC_MESSAGES, '');
  60
  61             my $langtag = C4::Languages::getlanguage;
  62             my @subtags = split /-/, $langtag;
  63             my ($language, $region) = @subtags;
  64             if ($region && length $region == 4) {
  65                 $region = $subtags[2];
  66             }
  67             my $locale = $language;
  68             if ($region) {
  69                 $locale .= '_' . $region;
  70             }
  71
  72             $ENV{LANGUAGE} = $locale;
  73             $ENV{OUTPUT_CHARSET} = 'UTF-8';
  74
  75             my $directory = _base_directory();
  76             textdomain($textdomain);
  77             bindtextdomain($textdomain, $directory);
  78         } else {
  79             warn "No locale installed. Localization cannot work and is therefore disabled";
  80         }
  81
  82         $cache->set_in_cache($cache_key, 1);
  83     }
  84 }
  85
  86 sub __ {
  87     my ($msgid) = @_;
  88
  89     $msgid = Encode::encode_utf8($msgid);
  90
  91     return _gettext(\&gettext, [ $msgid ]);
  92 }
  93
  94 sub __x {
  95     my ($msgid, %vars) = @_;
  96
  97     $msgid = Encode::encode_utf8($msgid);
  98
  99     return _gettext(\&gettext, [ $msgid ], %vars);
 100 }
 101
 102 sub __n {
 103     my ($msgid, $msgid_plural, $count) = @_;
 104
 105     $msgid = Encode::encode_utf8($msgid);
 106     $msgid_plural = Encode::encode_utf8($msgid_plural);
 107
 108     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ]);
 109 }
 110
 111 sub __nx {
 112     my ($msgid, $msgid_plural, $count, %vars) = @_;
 113
 114     $msgid = Encode::encode_utf8($msgid);
 115     $msgid_plural = Encode::encode_utf8($msgid_plural);
 116
 117     return _gettext(\&ngettext, [ $msgid, $msgid_plural, $count ], %vars);
 118 }
 119
 120 sub __xn {
 121     return __nx(@_);
 122 }
 123
 124 sub __p {
 125     my ($msgctxt, $msgid) = @_;
 126
 127     $msgctxt = Encode::encode_utf8($msgctxt);
 128     $msgid = Encode::encode_utf8($msgid);
 129
 130     return _gettext(\&pgettext, [ $msgctxt, $msgid ]);
 131 }
 132
 133 sub __px {
 134     my ($msgctxt, $msgid, %vars) = @_;
 135
 136     $msgctxt = Encode::encode_utf8($msgctxt);
 137     $msgid = Encode::encode_utf8($msgid);
 138
 139     return _gettext(\&pgettext, [ $msgctxt, $msgid ], %vars);
 140 }
 141
 142 sub __np {
 143     my ($msgctxt, $msgid, $msgid_plural, $count) = @_;
 144
 145     $msgctxt = Encode::encode_utf8($msgctxt);
 146     $msgid = Encode::encode_utf8($msgid);
 147     $msgid_plural = Encode::encode_utf8($msgid_plural);
 148
 149     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count ]);
 150 }
 151
 152 sub __npx {
 153     my ($msgctxt, $msgid, $msgid_plural, $count, %vars) = @_;
 154
 155     $msgctxt = Encode::encode_utf8($msgctxt);
 156     $msgid = Encode::encode_utf8($msgid);
 157     $msgid_plural = Encode::encode_utf8($msgid_plural);
 158
 159     return _gettext(\&npgettext, [ $msgctxt, $msgid, $msgid_plural, $count], %vars);
 160 }
 161
 162 sub N__ {
 163     return @_;
 164 }
 165
 166 sub N__n {
 167     return @_;
 168 }
 169
 170 sub N__p {
 171     return @_;
 172 }
 173
 174 sub N__np {
 175     return @_;
 176 }
 177
 178 sub _base_directory {
 179     return C4::Context->config('intranetdir') . '/misc/translator/po';
 180 }
 181
 182 sub _gettext {
 183     my ($sub, $args, %vars) = @_;
 184
 185     init();
 186
 187     my $text = Encode::decode_utf8($sub->(@$args));
 188     if (%vars) {
 189         $text = _expand($text, %vars);
 190     }
 191
 192     return $text;
 193 }
 194
 195 sub _expand {
 196     my ($text, %vars) = @_;
 197
 198     my $re = join '|', map { quotemeta $_ } keys %vars;
 199     $text =~ s/\{($re)\}/defined $vars{$1} ? $vars{$1} : "{$1}"/ge;
 200
 201     return $text;
 202 }
 203
 204 1;