File Coverage

blib/lib/Dpkg/Gettext.pm
Criterion Covered Total %
statement 28 49 57.1
branch 2 8 25.0
condition 1 2 50.0
subroutine 9 11 81.8
pod 1 1 100.0
total 41 71 57.7


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