"Fossies" - the Fresh Open Source Software Archive

Member "dpkg-1.19.7/scripts/Dpkg/Gettext.pm" (19 Apr 2019, 6019 Bytes) of package /linux/misc/dpkg_1.19.7.tar.xz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. For more information about "Gettext.pm" see the Fossies "Dox" file reference documentation.

    1 # Copied from /usr/share/perl5/Debconf/Gettext.pm
    2 #
    3 # Copyright © 2000 Joey Hess <joeyh@debian.org>
    4 # Copyright © 2007, 2009-2010, 2012-2017 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 use feature qw(state);
   32 
   33 our $VERSION = '1.03';
   34 our @EXPORT = qw(
   35     textdomain
   36     ngettext
   37     g_
   38     P_
   39     N_
   40     _g
   41 );
   42 
   43 use Exporter qw(import);
   44 
   45 =encoding utf8
   46 
   47 =head1 NAME
   48 
   49 Dpkg::Gettext - convenience wrapper around Locale::gettext
   50 
   51 =head1 DESCRIPTION
   52 
   53 The Dpkg::Gettext module is a convenience wrapper over the Locale::gettext
   54 module, to guarantee we always have working gettext functions, and to add
   55 some commonly used aliases.
   56 
   57 =head1 ENVIRONMENT
   58 
   59 =over 4
   60 
   61 =item DPKG_NLS
   62 
   63 When set to 0, this environment variable will disable the National Language
   64 Support in all Dpkg modules.
   65 
   66 =back
   67 
   68 =head1 VARIABLES
   69 
   70 =over 4
   71 
   72 =item $Dpkg::Gettext::DEFAULT_TEXT_DOMAIN
   73 
   74 Specifies the default text domain name to be used with the short function
   75 aliases. This is intended to be used by the Dpkg modules, so that they
   76 can produce localized messages even when the calling program has set the
   77 current domain with textdomain(). If you would like to use the aliases
   78 for your own modules, you might want to set this variable to undef, or
   79 to another domain, but then the Dpkg modules will not produce localized
   80 messages.
   81 
   82 =back
   83 
   84 =cut
   85 
   86 our $DEFAULT_TEXT_DOMAIN = 'dpkg-dev';
   87 
   88 =head1 FUNCTIONS
   89 
   90 =over 4
   91 
   92 =item $domain = textdomain($new_domain)
   93 
   94 Compatibility textdomain() fallback when Locale::gettext is not available.
   95 
   96 If $new_domain is not undef, it will set the current domain to $new_domain.
   97 Returns the current domain, after possibly changing it.
   98 
   99 =item $trans = ngettext($msgid, $msgid_plural, $n)
  100 
  101 Compatibility ngettext() fallback when Locale::gettext is not available.
  102 
  103 Returns $msgid if $n is 1 or $msgid_plural otherwise.
  104 
  105 =item $trans = g_($msgid)
  106 
  107 Calls dgettext() on the $msgid and returns its translation for the current
  108 locale. If dgettext() is not available, simply returns $msgid.
  109 
  110 =item $trans = C_($msgctxt, $msgid)
  111 
  112 Calls dgettext() on the $msgid and returns its translation for the specific
  113 $msgctxt supplied. If dgettext() is not available, simply returns $msgid.
  114 
  115 =item $trans = P_($msgid, $msgid_plural, $n)
  116 
  117 Calls dngettext(), returning the correct translation for the plural form
  118 dependent on $n. If dngettext() is not available, returns $msgid if $n is 1
  119 or $msgid_plural otherwise.
  120 
  121 =cut
  122 
  123 use constant GETTEXT_CONTEXT_GLUE => "\004";
  124 
  125 BEGIN {
  126     my $use_gettext = $ENV{DPKG_NLS} // 1;
  127     if ($use_gettext) {
  128         eval q{
  129             pop @INC if $INC[-1] eq '.';
  130             use Locale::gettext;
  131         };
  132         $use_gettext = not $@;
  133     }
  134     if (not $use_gettext) {
  135         *g_ = sub {
  136             return shift;
  137         };
  138         *textdomain = sub {
  139             my $new_domain = shift;
  140             state $domain = $DEFAULT_TEXT_DOMAIN;
  141 
  142             $domain = $new_domain if defined $new_domain;
  143 
  144             return $domain;
  145         };
  146         *ngettext = sub {
  147             my ($msgid, $msgid_plural, $n) = @_;
  148             if ($n == 1) {
  149                 return $msgid;
  150             } else {
  151                 return $msgid_plural;
  152             }
  153         };
  154         *C_ = sub {
  155             my ($msgctxt, $msgid) = @_;
  156             return $msgid;
  157         };
  158         *P_ = sub {
  159             return ngettext(@_);
  160         };
  161     } else {
  162         *g_ = sub {
  163             return dgettext($DEFAULT_TEXT_DOMAIN, shift);
  164         };
  165         *C_ = sub {
  166             my ($msgctxt, $msgid) = @_;
  167             return dgettext($DEFAULT_TEXT_DOMAIN,
  168                             $msgctxt . GETTEXT_CONTEXT_GLUE . $msgid);
  169         };
  170         *P_ = sub {
  171             return dngettext($DEFAULT_TEXT_DOMAIN, @_);
  172         };
  173     }
  174 }
  175 
  176 =item $msgid = N_($msgid)
  177 
  178 A pseudo function that servers as a marked for automated extraction of
  179 messages, but does not call gettext(). The run-time translation is done
  180 at a different place in the code.
  181 
  182 =back
  183 
  184 =cut
  185 
  186 sub N_
  187 {
  188     my $msgid = shift;
  189     return $msgid;
  190 }
  191 
  192 # XXX: Backwards compatibility, to be removed on VERSION 2.00.
  193 sub _g ## no critic (Subroutines::ProhibitUnusedPrivateSubroutines)
  194 {
  195     my $msgid = shift;
  196 
  197     warnings::warnif('deprecated',
  198                      'obsolete _g() function, please use g_() instead');
  199 
  200     return g_($msgid);
  201 }
  202 
  203 =head1 CHANGES
  204 
  205 =head2 Version 1.03 (dpkg 1.19.0)
  206 
  207 New envvar: Add support for new B<DPKG_NLS> environment variable.
  208 
  209 =head2 Version 1.02 (dpkg 1.18.3)
  210 
  211 New function: N_().
  212 
  213 =head2 Version 1.01 (dpkg 1.18.0)
  214 
  215 Now the short aliases (g_ and P_) will call domain aware functions with
  216 $DEFAULT_TEXT_DOMAIN.
  217 
  218 New functions: g_(), C_().
  219 
  220 Deprecated function: _g().
  221 
  222 =head2 Version 1.00 (dpkg 1.15.6)
  223 
  224 Mark the module as public.
  225 
  226 =cut
  227 
  228 1;