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