chiark - git - mdw - dpkg/blob - scripts/Dpkg/Gettext.pm

   1 # Copied from /usr/share/perl5/Debconf/Gettext.pm
   2 #
   3 # Copyright © 2000 Joey Hess <joeyh@debian.org>
   4 # Copyright © 2007, 2009-2010, 2012-2015 Guillem Jover <guillem@debian.org>
   5 #
   6 # Redistribution and use in source and binary forms, with or without
   7 # modification, are permitted provided that the following conditions
   8 # are met:
   9 # 1. Redistributions of source code must retain the above copyright
  10 #    notice, this list of conditions and the following disclaimer.
  11 # 2. Redistributions in binary form must reproduce the above copyright
  12 #    notice, this list of conditions and the following disclaimer in the
  13 #    documentation and/or other materials provided with the distribution.
  14 #
  15 # THIS SOFTWARE IS PROVIDED BY AUTHORS AND CONTRIBUTORS ``AS IS'' AND
  16 # ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
  17 # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
  18 # ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE
  19 # FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
  20 # DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
  21 # OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
  22 # HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT
  23 # LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY
  24 # OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
  25 # SUCH DAMAGE.
  26
  27 package Dpkg::Gettext;
  28
  29 use strict;
  30 use warnings;
  31
  32 our $VERSION = '1.02';
  33 our @EXPORT = qw(
  34     textdomain
  35     ngettext
  36     g_
  37     P_
  38     N_
  39     _g
  40 );
  41
  42 use Exporter qw(import);
  43
  44 =encoding utf8
  45
  46 =head1 NAME
  47
  48 Dpkg::Gettext - convenience wrapper around Locale::gettext
  49
  50 =head1 DESCRIPTION
  51
  52 The Dpkg::Gettext module is a convenience wrapper over the Locale::gettext
  53 module, to guarantee we always have working gettext functions, and to add
  54 some commonly used aliases.
  55
  56 =head1 VARIABLES
  57
  58 =over 4
  59
  60 =item $Dpkg::Gettext::DEFAULT_TEXT_DOMAIN
  61
  62 Specifies the default text domain name to be used with the short function
  63 aliases. This is intended to be used by the Dpkg modules, so that they
  64 can produce localized messages even when the calling program has set the
  65 current domain with textdomain(). If you would like to use the aliases
  66 for your own modules, you might want to set this variable to undef, or
  67 to another domain, but then the Dpkg modules will not produce localized
  68 messages.
  69
  70 =back
  71
  72 =cut
  73
  74 our $DEFAULT_TEXT_DOMAIN = 'dpkg-dev';
  75
  76 =head1 FUNCTIONS
  77
  78 =over 4
  79
  80 =item $trans = g_($msgid)
  81
  82 Calls dgettext() on the $msgid and returns its translation for the current
  83 locale. If dgettext() is not available, simply returns $msgid.
  84
  85 =item $trans = C_($msgctxt, $msgid)
  86
  87 Calls dgettext() on the $msgid and returns its translation for the specific
  88 $msgctxt supplied. If dgettext() is not available, simply returns $msgid.
  89
  90 =item $trans = P_($msgid, $msgid_plural, $n)
  91
  92 Calls dngettext(), returning the correct translation for the plural form
  93 dependent on $n. If dngettext() is not available, returns $msgid if $n is 1
  94 or $msgid_plural otherwise.
  95
  96 =cut
  97
  98 use constant GETTEXT_CONTEXT_GLUE => "\004";
  99
 100 BEGIN {
 101     eval q{
 102         pop @INC if $INC[-1] eq '.';
 103         use Locale::gettext;
 104     };
 105     if ($@) {
 106         eval q{
 107             sub g_ {
 108                 return shift;
 109             }
 110             sub textdomain {
 111             }
 112             sub ngettext {
 113                 my ($msgid, $msgid_plural, $n) = @_;
 114                 if ($n == 1) {
 115                     return $msgid;
 116                 } else {
 117                     return $msgid_plural;
 118                 }
 119             }
 120             sub C_ {
 121                 my ($msgctxt, $msgid) = @_;
 122                 return $msgid;
 123             }
 124             sub P_ {
 125                 return ngettext(@_);
 126             }
 127         };
 128     } else {
 129         eval q{
 130             sub g_ {
 131                 return dgettext($DEFAULT_TEXT_DOMAIN, shift);
 132             }
 133             sub C_ {
 134                 my ($msgctxt, $msgid) = @_;
 135                 return dgettext($DEFAULT_TEXT_DOMAIN,
 136                                 $msgctxt . GETTEXT_CONTEXT_GLUE . $msgid);
 137             }
 138             sub P_ {
 139                 return dngettext($DEFAULT_TEXT_DOMAIN, @_);
 140             }
 141         };
 142     }
 143 }
 144
 145 =item $msgid = N_($msgid)
 146
 147 A pseudo function that servers as a marked for automated extraction of
 148 messages, but does not call gettext(). The run-time translation is done
 149 at a different place in the code.
 150
 151 =back
 152
 153 =cut
 154
 155 sub N_
 156 {
 157     my $msgid = shift;
 158     return $msgid;
 159 }
 160
 161 # XXX: Backwards compatibility, to be removed on VERSION 2.00.
 162 sub _g ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
 163 {
 164     my $msgid = shift;
 165
 166     warnings::warnif('deprecated',
 167                      'obsolete _g() function, please use g_() instead');
 168
 169     return g_($msgid);
 170 }
 171
 172 =head1 CHANGES
 173
 174 =head2 Version 1.02 (dpkg 1.18.3)
 175
 176 New function: N_().
 177
 178 =head2 Version 1.01 (dpkg 1.18.0)
 179
 180 Now the short aliases (g_ and P_) will call domain aware functions with
 181 $DEFAULT_TEXT_DOMAIN.
 182
 183 New functions: g_(), C_().
 184
 185 Deprecated function: _g().
 186
 187 =head2 Version 1.00 (dpkg 1.15.6)
 188
 189 Mark the module as public.
 190
 191 =cut
 192
 193 1;