Filename | /usr/local/lib/perl5/site_perl/Locale/gettext_pp.pm |
Statements | Executed 2601750 statements in 1.53s |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
35811 | 1 | 1 | 704ms | 1.95s | _dcnpgettext_impl | Locale::gettext_pp::
35811 | 1 | 1 | 504ms | 996ms | __load_domain | Locale::gettext_pp::
25 | 1 | 1 | 148ms | 165ms | __load_catalog | Locale::gettext_pp::
35811 | 1 | 1 | 109ms | 109ms | __selected_locales | Locale::gettext_pp::
35811 | 1 | 1 | 83.1ms | 83.1ms | bindtextdomain | Locale::gettext_pp::
34661 | 1 | 1 | 72.6ms | 72.6ms | textdomain | Locale::gettext_pp::
100 | 4 | 1 | 9.79ms | 9.79ms | CORE:unpack (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 3.08ms | 3.08ms | CORE:readline (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 2.39ms | 2.53ms | __compile_plural_function | Locale::gettext_pp::
25 | 1 | 1 | 407µs | 407µs | CORE:open (opcode) | Locale::gettext_pp::
322 | 3 | 1 | 382µs | 382µs | CORE:subst (opcode) | Locale::gettext_pp::
28 | 1 | 1 | 328µs | 328µs | CORE:ftdir (opcode) | Locale::gettext_pp::
24 | 1 | 1 | 295µs | 356µs | __extend_locales | Locale::gettext_pp::
74 | 3 | 1 | 255µs | 255µs | CORE:match (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 216µs | 216µs | CORE:ftfile (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 196µs | 468µs | __untaint_plural_header | Locale::gettext_pp::
25 | 1 | 1 | 195µs | 195µs | CORE:fteread (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 147µs | 147µs | CORE:regcomp (opcode) | Locale::gettext_pp::
105 | 1 | 1 | 96µs | 96µs | CORE:substcont (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 77µs | 77µs | CORE:close (opcode) | Locale::gettext_pp::
25 | 1 | 1 | 26µs | 26µs | CORE:binmode (opcode) | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@123 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@24 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@28 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@39 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@40 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@41 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@43 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@65 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | BEGIN@68 | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_ALL | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_COLLATE | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_CTYPE | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_MONETARY | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_NUMERIC | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | LC_TIME | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | __ANON__ (xsub) | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | __get_codeset | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | __locale_category | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | bind_textdomain_codeset | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dcgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dcngettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dcnpgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dcpgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dngettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dnpgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | dpgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | gettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | ngettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | nl_putenv | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | npgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | pgettext | Locale::gettext_pp::
0 | 0 | 0 | 0s | 0s | setlocale | Locale::gettext_pp::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | #! /bin/false | ||||
2 | |||||
3 | # vim: set autoindent shiftwidth=4 tabstop=4: | ||||
4 | |||||
5 | # Pure Perl implementation of Uniforum message translation. | ||||
6 | # Copyright (C) 2002-2017 Guido Flohr <guido.flohr@cantanea.com>, | ||||
7 | # all rights reserved. | ||||
8 | |||||
9 | # This program is free software: you can redistribute it and/or modify | ||||
10 | # it under the terms of the GNU General Public License as published by | ||||
11 | # the Free Software Foundation; either version 3 of the License, or | ||||
12 | # (at your option) any later version. | ||||
13 | |||||
14 | # This program is distributed in the hope that it will be useful, | ||||
15 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
16 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||
17 | # GNU General Public License for more details. | ||||
18 | |||||
19 | # You should have received a copy of the GNU General Public License | ||||
20 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | ||||
21 | |||||
22 | package Locale::gettext_pp; | ||||
23 | |||||
24 | use strict; | ||||
25 | |||||
26 | require 5.004; | ||||
27 | |||||
28 | use vars qw ($__gettext_pp_default_dir | ||||
29 | $__gettext_pp_textdomain | ||||
30 | $__gettext_pp_domain_bindings | ||||
31 | $__gettext_pp_domain_codeset_bindings | ||||
32 | $__gettext_pp_domains | ||||
33 | $__gettext_pp_recoders | ||||
34 | $__gettext_pp_unavailable_dirs | ||||
35 | $__gettext_pp_domain_cache | ||||
36 | $__gettext_pp_alias_cache | ||||
37 | $__gettext_pp_context_glue); | ||||
38 | |||||
39 | use locale; | ||||
40 | use File::Spec; | ||||
41 | use Locale::Messages; | ||||
42 | |||||
43 | BEGIN { | ||||
44 | $__gettext_pp_textdomain = 'messages'; | ||||
45 | $__gettext_pp_domain_bindings = {}; | ||||
46 | $__gettext_pp_domain_codeset_bindings = {}; | ||||
47 | $__gettext_pp_domains = {}; | ||||
48 | $__gettext_pp_recoders = {}; | ||||
49 | $__gettext_pp_unavailable_dirs = {}; | ||||
50 | $__gettext_pp_domain_cache = {}; | ||||
51 | $__gettext_pp_alias_cache = {}; | ||||
52 | # The separator between msgctxt and msgid in a .mo file. */ | ||||
53 | $__gettext_pp_context_glue = "\004"; | ||||
54 | |||||
55 | $__gettext_pp_default_dir = ''; | ||||
56 | |||||
57 | for my $dir (qw (/usr/share/locale /usr/local/share/locale)) { | ||||
58 | if (-d $dir) { | ||||
59 | $__gettext_pp_default_dir = $dir; | ||||
60 | last; | ||||
61 | } | ||||
62 | } | ||||
63 | } | ||||
64 | |||||
65 | BEGIN { | ||||
66 | require POSIX; | ||||
67 | require Exporter; | ||||
68 | use IO::Handle; | ||||
69 | require Locale::Recode; | ||||
70 | |||||
71 | local $@; | ||||
72 | my ($has_messages, $five_ok); | ||||
73 | |||||
74 | $has_messages = eval '&POSIX::LC_MESSAGES'; # spent 0s executing statements in string eval | ||||
75 | |||||
76 | unless (defined $has_messages && length $has_messages) { | ||||
77 | $five_ok = ! grep {my $x = eval "&POSIX::$_" || 0; $x eq '5';} | ||||
78 | qw (LC_CTYPE | ||||
79 | LC_NUMERIC | ||||
80 | LC_TIME | ||||
81 | LC_COLLATE | ||||
82 | LC_MONETARY | ||||
83 | LC_ALL); | ||||
84 | if ($five_ok) { | ||||
85 | $five_ok = POSIX::setlocale (5, ''); | ||||
86 | } | ||||
87 | } | ||||
88 | |||||
89 | if (defined $has_messages && length $has_messages) { | ||||
90 | eval <<'EOF'; # spent 426ms executing statements in string eval # includes 239ms spent executing 71622 calls to 1 sub defined therein. | ||||
91 | sub LC_MESSAGES() | ||||
92 | { | ||||
93 | local $!; # Do not clobber errno! | ||||
94 | |||||
95 | return &POSIX::LC_MESSAGES; | ||||
96 | } | ||||
97 | EOF | ||||
98 | } elsif ($five_ok) { | ||||
99 | eval <<'EOF'; | ||||
100 | sub LC_MESSAGES() | ||||
101 | { | ||||
102 | local $!; # Do not clobber errno! | ||||
103 | |||||
104 | # Hack: POSIX.pm deems LC_MESSAGES an invalid macro until | ||||
105 | # Perl 5.8.0. However, on LC_MESSAGES should be 5 ... | ||||
106 | return 5; | ||||
107 | } | ||||
108 | EOF | ||||
109 | } else { | ||||
110 | eval <<'EOF'; | ||||
111 | sub LC_MESSAGES() | ||||
112 | { | ||||
113 | local $!; # Do not clobber errno! | ||||
114 | |||||
115 | # This fallback value is widely used, | ||||
116 | # when LC_MESSAGES is not available. | ||||
117 | return 1729; | ||||
118 | } | ||||
119 | EOF | ||||
120 | } | ||||
121 | } | ||||
122 | |||||
123 | use vars qw (%EXPORT_TAGS @EXPORT_OK @ISA $VERSION); | ||||
124 | |||||
125 | %EXPORT_TAGS = (locale_h => [ qw ( | ||||
126 | gettext | ||||
127 | dgettext | ||||
128 | dcgettext | ||||
129 | ngettext | ||||
130 | dngettext | ||||
131 | dcngettext | ||||
132 | pgettext | ||||
133 | dpgettext | ||||
134 | dcpgettext | ||||
135 | npgettext | ||||
136 | dnpgettext | ||||
137 | dcnpgettext | ||||
138 | textdomain | ||||
139 | bindtextdomain | ||||
140 | bind_textdomain_codeset | ||||
141 | ) | ||||
142 | ], | ||||
143 | libintl_h => [ qw (LC_CTYPE | ||||
144 | LC_NUMERIC | ||||
145 | LC_TIME | ||||
146 | LC_COLLATE | ||||
147 | LC_MONETARY | ||||
148 | LC_MESSAGES | ||||
149 | LC_ALL) | ||||
150 | ], | ||||
151 | ); | ||||
152 | |||||
153 | @EXPORT_OK = qw (gettext | ||||
154 | dgettext | ||||
155 | dcgettext | ||||
156 | ngettext | ||||
157 | dngettext | ||||
158 | dcngettext | ||||
159 | pgettext | ||||
160 | dpgettext | ||||
161 | dcpgettext | ||||
162 | npgettext | ||||
163 | dnpgettext | ||||
164 | dcnpgettext | ||||
165 | textdomain | ||||
166 | bindtextdomain | ||||
167 | bind_textdomain_codeset | ||||
168 | nl_putenv | ||||
169 | setlocale | ||||
170 | LC_CTYPE | ||||
171 | LC_NUMERIC | ||||
172 | LC_TIME | ||||
173 | LC_COLLATE | ||||
174 | LC_MONETARY | ||||
175 | LC_MESSAGES | ||||
176 | LC_ALL); | ||||
177 | @ISA = qw (Exporter); | ||||
178 | |||||
179 | my $has_nl_langinfo; | ||||
180 | |||||
181 | sub __load_catalog; | ||||
182 | sub __load_domain; | ||||
183 | sub __locale_category; | ||||
184 | sub __untaint_plural_header; | ||||
185 | sub __compile_plural_function; | ||||
186 | |||||
187 | sub LC_NUMERIC() | ||||
188 | { | ||||
189 | &POSIX::LC_NUMERIC; | ||||
190 | } | ||||
191 | |||||
192 | sub LC_CTYPE() | ||||
193 | { | ||||
194 | &POSIX::LC_CTYPE; | ||||
195 | } | ||||
196 | |||||
197 | sub LC_TIME() | ||||
198 | { | ||||
199 | &POSIX::LC_TIME; | ||||
200 | } | ||||
201 | |||||
202 | sub LC_COLLATE() | ||||
203 | { | ||||
204 | &POSIX::LC_COLLATE; | ||||
205 | } | ||||
206 | |||||
207 | sub LC_MONETARY() | ||||
208 | { | ||||
209 | &POSIX::LC_MONETARY; | ||||
210 | } | ||||
211 | |||||
212 | sub LC_ALL() | ||||
213 | { | ||||
214 | &POSIX::LC_ALL; | ||||
215 | } | ||||
216 | |||||
217 | sub textdomain(;$) | ||||
218 | # spent 72.6ms within Locale::gettext_pp::textdomain which was called 34661 times, avg 2µs/call:
# 34661 times (72.6ms+0s) by Locale::Messages::textdomain at line 229 of Locale/Messages.pm, avg 2µs/call | ||||
219 | 34661 | 8.01ms | my $new_domain = shift; | ||
220 | |||||
221 | 34661 | 6.54ms | $__gettext_pp_textdomain = $new_domain if defined $new_domain && | ||
222 | length $new_domain; | ||||
223 | |||||
224 | 34661 | 103ms | return $__gettext_pp_textdomain; | ||
225 | } | ||||
226 | |||||
227 | sub bindtextdomain($;$) | ||||
228 | # spent 83.1ms within Locale::gettext_pp::bindtextdomain which was called 35811 times, avg 2µs/call:
# 35811 times (83.1ms+0s) by Locale::gettext_pp::__load_domain at line 563, avg 2µs/call | ||||
229 | 35811 | 11.2ms | my ($domain, $directory) = @_; | ||
230 | |||||
231 | 35811 | 4.90ms | my $retval; | ||
232 | 35811 | 7.98ms | if (defined $domain && length $domain) { | ||
233 | 35811 | 21.5ms | if (defined $directory && length $directory) { | ||
234 | $retval = $__gettext_pp_domain_bindings->{$domain} | ||||
235 | = $directory; | ||||
236 | } elsif (exists $__gettext_pp_domain_bindings->{$domain}) { | ||||
237 | $retval = $__gettext_pp_domain_bindings->{$domain}; | ||||
238 | } else { | ||||
239 | $retval = $__gettext_pp_default_dir; | ||||
240 | } | ||||
241 | 35811 | 6.14ms | $retval = '/usr/share/locale' unless defined $retval && | ||
242 | length $retval; | ||||
243 | 35811 | 114ms | return $retval; | ||
244 | } else { | ||||
245 | return; | ||||
246 | } | ||||
247 | } | ||||
248 | |||||
249 | sub bind_textdomain_codeset($;$) | ||||
250 | { | ||||
251 | my ($domain, $codeset) = @_; | ||||
252 | |||||
253 | if (defined $domain && length $domain) { | ||||
254 | if (defined $codeset && length $codeset) { | ||||
255 | return $__gettext_pp_domain_codeset_bindings->{$domain} = $codeset; | ||||
256 | } elsif (exists $__gettext_pp_domain_codeset_bindings->{$domain}) { | ||||
257 | return $__gettext_pp_domain_codeset_bindings->{$domain}; | ||||
258 | } | ||||
259 | } | ||||
260 | |||||
261 | return; | ||||
262 | } | ||||
263 | |||||
264 | sub gettext($) | ||||
265 | { | ||||
266 | my ($msgid) = @_; | ||||
267 | |||||
268 | return dcnpgettext ('', undef, $msgid, undef, undef, undef); | ||||
269 | } | ||||
270 | |||||
271 | sub dgettext($$) | ||||
272 | { | ||||
273 | my ($domainname, $msgid) = @_; | ||||
274 | |||||
275 | return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef); | ||||
276 | } | ||||
277 | |||||
278 | sub dcgettext($$$) | ||||
279 | { | ||||
280 | my ($domainname, $msgid, $category) = @_; | ||||
281 | |||||
282 | return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef); | ||||
283 | } | ||||
284 | |||||
285 | sub ngettext($$$) | ||||
286 | { | ||||
287 | my ($msgid, $msgid_plural, $n) = @_; | ||||
288 | |||||
289 | return dcnpgettext ('', undef, $msgid, $msgid_plural, $n, undef); | ||||
290 | } | ||||
291 | |||||
292 | sub dngettext($$$$) | ||||
293 | { | ||||
294 | my ($domainname, $msgid, $msgid_plural, $n) = @_; | ||||
295 | |||||
296 | return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, undef); | ||||
297 | } | ||||
298 | |||||
299 | sub dcngettext($$$$$) | ||||
300 | { | ||||
301 | my ($domainname, $msgid, $msgid_plural, $n, $category) = @_; | ||||
302 | |||||
303 | return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, , $category); | ||||
304 | } | ||||
305 | |||||
306 | |||||
307 | sub pgettext($$) | ||||
308 | { | ||||
309 | my ($msgctxt, $msgid) = @_; | ||||
310 | |||||
311 | return dcnpgettext ('', $msgctxt, $msgid, undef, undef, undef); | ||||
312 | } | ||||
313 | |||||
314 | sub dpgettext($$$) | ||||
315 | { | ||||
316 | my ($domainname, $msgctxt, $msgid) = @_; | ||||
317 | |||||
318 | return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef); | ||||
319 | } | ||||
320 | |||||
321 | sub dcpgettext($$$$) | ||||
322 | { | ||||
323 | my ($domainname, $msgctxt, $msgid, $category) = @_; | ||||
324 | |||||
325 | return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef); | ||||
326 | } | ||||
327 | |||||
328 | sub npgettext($$$$) | ||||
329 | { | ||||
330 | my ($msgctxt, $msgid, $msgid_plural, $n) = @_; | ||||
331 | |||||
332 | return dcnpgettext ('', $msgctxt, $msgid, $msgid_plural, $n, undef); | ||||
333 | } | ||||
334 | |||||
335 | sub dnpgettext($$$$$) | ||||
336 | { | ||||
337 | my ($domainname, $msgctxt, $msgid, $msgid_plural, $n) = @_; | ||||
338 | |||||
339 | return dcnpgettext ($domainname, $msgctxt, $msgid, $msgid_plural, $n, undef); | ||||
340 | } | ||||
341 | |||||
342 | # This is the actual implementation of dncpgettext. It is also used by the | ||||
343 | # corresponding function in Locale::gettext_dumb. | ||||
344 | # spent 1.95s (704ms+1.24) within Locale::gettext_pp::_dcnpgettext_impl which was called 35811 times, avg 54µs/call:
# 35811 times (704ms+1.24s) by Locale::gettext_dumb::dcnpgettext at line 187 of Locale/gettext_dumb.pm, avg 54µs/call | ||||
345 | 35811 | 17.9ms | my ($domainname, $msgctxt, $msgid, $msgid_plural, $n, $category, | ||
346 | $locale) = @_; | ||||
347 | |||||
348 | 35811 | 6.89ms | return unless defined $msgid; | ||
349 | |||||
350 | 35811 | 9.21ms | my $plural = defined $msgid_plural; | ||
351 | 35811 | 26.0ms | 35811 | 111ms | Locale::Messages::turn_utf_8_off($msgid); # spent 111ms making 35811 calls to Locale::Messages::turn_utf_8_off, avg 3µs/call |
352 | 35811 | 5.69ms | Locale::Messages::turn_utf_8_off($msgctxt) if defined $msgctxt; | ||
353 | 35811 | 9.12ms | my $msg_ctxt_id = defined $msgctxt ? join($__gettext_pp_context_glue, ($msgctxt, $msgid)) : $msgid; | ||
354 | |||||
355 | 35811 | 62.4ms | local $!; # Do not clobber errno! | ||
356 | |||||
357 | # This is also done in __load_domain but we need a proper value. | ||||
358 | 35811 | 12.0ms | $domainname = $__gettext_pp_textdomain | ||
359 | unless defined $domainname && length $domainname; | ||||
360 | |||||
361 | # Category is always LC_MESSAGES (other categories are ignored). | ||||
362 | 35811 | 7.17ms | my $category_name = 'LC_MESSAGES'; | ||
363 | 35811 | 33.4ms | 35811 | 137ms | $category = LC_MESSAGES; # spent 137ms making 35811 calls to Locale::gettext_pp::LC_MESSAGES, avg 4µs/call |
364 | |||||
365 | 35811 | 39.3ms | 35811 | 996ms | my $domains = __load_domain ($domainname, $category, $category_name, # spent 996ms making 35811 calls to Locale::gettext_pp::__load_domain, avg 28µs/call |
366 | $locale); | ||||
367 | |||||
368 | 35811 | 9.11ms | my @trans = (); | ||
369 | 35811 | 4.56ms | my $domain; | ||
370 | my $found; | ||||
371 | 35811 | 12.4ms | foreach my $this_domain (@$domains) { | ||
372 | 35811 | 29.6ms | if ($this_domain && defined $this_domain->{messages}->{$msg_ctxt_id}) { | ||
373 | 35581 | 22.6ms | @trans = @{$this_domain->{messages}->{$msg_ctxt_id}}; | ||
374 | 35581 | 7.29ms | shift @trans; | ||
375 | 35581 | 5.55ms | $domain = $this_domain; | ||
376 | 35581 | 5.49ms | $found = 1; | ||
377 | 35581 | 7.54ms | last; | ||
378 | } | ||||
379 | } | ||||
380 | 35811 | 5.99ms | @trans = ($msgid, $msgid_plural) unless @trans; | ||
381 | |||||
382 | 35811 | 7.33ms | my $trans = $trans[0]; | ||
383 | 35811 | 6.25ms | if ($plural) { | ||
384 | if ($domain) { | ||||
385 | my $nplurals = 0; | ||||
386 | ($nplurals, $plural) = &{$domain->{plural_func}} ($n); | ||||
387 | $plural = 0 unless defined $plural; | ||||
388 | $nplurals = 0 unless defined $nplurals; | ||||
389 | $plural = 0 if $nplurals <= $plural; | ||||
390 | } else { | ||||
391 | $plural = $n != 1 || 0; | ||||
392 | } | ||||
393 | |||||
394 | $trans = $trans[$plural] if defined $trans[$plural]; | ||||
395 | } | ||||
396 | |||||
397 | 35811 | 19.2ms | if ($found && defined $domain->{po_header}->{charset}) { | ||
398 | 35581 | 11.8ms | my $input_codeset = $domain->{po_header}->{charset}; | ||
399 | # Convert into output charset. | ||||
400 | 35581 | 11.5ms | my $output_codeset = $__gettext_pp_domain_codeset_bindings->{$domainname}; | ||
401 | |||||
402 | 35581 | 5.25ms | $output_codeset = $ENV{OUTPUT_CHARSET} unless defined $output_codeset; | ||
403 | $output_codeset = __get_codeset ($category, $category_name, | ||||
404 | $domain->{locale_id}) | ||||
405 | 35581 | 4.71ms | unless defined $output_codeset; | ||
406 | |||||
407 | 35581 | 3.99ms | unless (defined $output_codeset) { | ||
408 | # Still no point. | ||||
409 | my $lc_ctype = __locale_category (POSIX::LC_CTYPE(), | ||||
410 | 'LC_CTYPE'); | ||||
411 | $output_codeset = $1 | ||||
412 | if $lc_ctype =~ /^[a-z]{2}(?:_[A-Z]{2})?\.([^@]+)/; | ||||
413 | } | ||||
414 | |||||
415 | # No point. :-( | ||||
416 | $output_codeset = $domain->{po_header}->{charset} | ||||
417 | 35581 | 4.34ms | unless defined $output_codeset; | ||
418 | |||||
419 | 35581 | 14.6ms | if (exists $__gettext_pp_domain_cache->{$output_codeset}) { | ||
420 | $output_codeset = $__gettext_pp_domain_cache->{$output_codeset}; | ||||
421 | } else { | ||||
422 | 1 | 1µs | $output_codeset = 'utf-8' if lc $output_codeset eq 'utf8'; | ||
423 | $output_codeset = | ||||
424 | 1 | 3µs | 1 | 5µs | $__gettext_pp_domain_cache->{$output_codeset} = # spent 5µs making 1 call to Locale::Recode::resolveAlias |
425 | Locale::Recode->resolveAlias ($output_codeset); | ||||
426 | } | ||||
427 | |||||
428 | 35581 | 20.3ms | if (defined $output_codeset && | ||
429 | $output_codeset ne $domain->{po_header}->{charset}) { | ||||
430 | # We have to convert. | ||||
431 | my $recoder; | ||||
432 | |||||
433 | if (exists | ||||
434 | $__gettext_pp_recoders->{$input_codeset}->{$output_codeset}) { | ||||
435 | $recoder = $__gettext_pp_recoders->{$input_codeset}->{$output_codeset}; | ||||
436 | } else { | ||||
437 | $recoder = | ||||
438 | $__gettext_pp_recoders->{$input_codeset}->{$output_codeset} = | ||||
439 | Locale::Recode->new (from => $input_codeset, | ||||
440 | to => $output_codeset, | ||||
441 | ); | ||||
442 | } | ||||
443 | |||||
444 | $recoder->recode ($trans); | ||||
445 | } | ||||
446 | } | ||||
447 | |||||
448 | 35811 | 130ms | return $trans; | ||
449 | } | ||||
450 | |||||
451 | sub dcnpgettext ($$$$$$) { | ||||
452 | return &_dcnpgettext_impl; | ||||
453 | } | ||||
454 | |||||
455 | sub nl_putenv ($) | ||||
456 | { | ||||
457 | my ($envspec) = @_; | ||||
458 | return unless defined $envspec; | ||||
459 | return unless length $envspec; | ||||
460 | return if substr ($envspec, 0, 1) eq '='; | ||||
461 | |||||
462 | my ($var, $value) = split /=/, $envspec, 2; | ||||
463 | |||||
464 | # In Perl we *could* set empty environment variables even under | ||||
465 | # MS-DOS, but for compatibility reasons, we implement the | ||||
466 | # brain-damaged behavior of the Microsoft putenv(). | ||||
467 | if ($^O eq 'MSWin32') { | ||||
468 | $value = '' unless defined $value; | ||||
469 | if (length $value) { | ||||
470 | $ENV{$var} = $value; | ||||
471 | } else { | ||||
472 | delete $ENV{$var}; | ||||
473 | } | ||||
474 | } else { | ||||
475 | if (defined $value) { | ||||
476 | $ENV{$var} = $value; | ||||
477 | } else { | ||||
478 | delete $ENV{$var}; | ||||
479 | } | ||||
480 | } | ||||
481 | |||||
482 | return 1; | ||||
483 | } | ||||
484 | |||||
485 | sub setlocale($;$) { | ||||
486 | require POSIX; | ||||
487 | &POSIX::setlocale; | ||||
488 | } | ||||
489 | |||||
490 | # spent 109ms within Locale::gettext_pp::__selected_locales which was called 35811 times, avg 3µs/call:
# 35811 times (109ms+0s) by Locale::gettext_pp::__load_domain at line 568, avg 3µs/call | ||||
491 | 35811 | 12.8ms | my ($locale, $category, $category_name) = @_; | ||
492 | |||||
493 | 35811 | 4.55ms | my @locales; | ||
494 | my $cache_key; | ||||
495 | |||||
496 | 35811 | 17.5ms | if (defined $ENV{LANGUAGE} && length $ENV{LANGUAGE}) { | ||
497 | 35811 | 27.5ms | @locales = split /:/, $ENV{LANGUAGE}; | ||
498 | 35811 | 9.90ms | $cache_key = $ENV{LANGUAGE}; | ||
499 | } elsif (!defined $locale) { | ||||
500 | # The system does not have LC_MESSAGES. Guess the value. | ||||
501 | @locales = $cache_key = __locale_category ($category, | ||||
502 | $category_name); | ||||
503 | } else { | ||||
504 | @locales = $cache_key = $locale; | ||||
505 | } | ||||
506 | |||||
507 | 35811 | 149ms | return $cache_key, @locales; | ||
508 | } | ||||
509 | |||||
510 | # spent 356µs (295+61) within Locale::gettext_pp::__extend_locales which was called 24 times, avg 15µs/call:
# 24 times (295µs+61µs) by Locale::gettext_pp::__load_domain at line 576, avg 15µs/call | ||||
511 | 24 | 10µs | my (@locales) = @_; | ||
512 | |||||
513 | 24 | 14µs | my @tries = @locales; | ||
514 | 24 | 46µs | my %locale_lookup = map { $_ => $_ } @tries; | ||
515 | |||||
516 | 24 | 12µs | foreach my $locale (@locales) { | ||
517 | 24 | 135µs | 24 | 61µs | if ($locale =~ /^([a-z][a-z]) # spent 61µs making 24 calls to Locale::gettext_pp::CORE:match, avg 3µs/call |
518 | (?:(_[A-Z][A-Z])? | ||||
519 | (\.[-_A-Za-z0-9]+)? | ||||
520 | )? | ||||
521 | (\@[-_A-Za-z0-9]+)?$/x) { | ||||
522 | |||||
523 | 24 | 22µs | if (defined $3) { | ||
524 | defined $2 ? | ||||
525 | push @tries, $1 . $2 . $3 : push @tries, $1 . $3; | ||||
526 | $locale_lookup{$tries[-1]} = $locale; | ||||
527 | } | ||||
528 | 24 | 14µs | if (defined $2) { | ||
529 | 5 | 7µs | push @tries, $1 . $2; | ||
530 | 5 | 5µs | $locale_lookup{$1 . $2} = $locale; | ||
531 | } | ||||
532 | 24 | 14µs | if (defined $1) { | ||
533 | 24 | 16µs | push @tries, $1 if defined $1; | ||
534 | 24 | 23µs | $locale_lookup{$1} = $locale; | ||
535 | } | ||||
536 | } | ||||
537 | } | ||||
538 | |||||
539 | 24 | 55µs | return \@tries, \%locale_lookup; | ||
540 | } | ||||
541 | |||||
542 | # spent 996ms (504+492) within Locale::gettext_pp::__load_domain which was called 35811 times, avg 28µs/call:
# 35811 times (504ms+492ms) by Locale::gettext_pp::_dcnpgettext_impl at line 365, avg 28µs/call | ||||
543 | 35811 | 15.2ms | my ($domainname, $category, $category_name, $locale) = @_; | ||
544 | |||||
545 | # If no locale was selected for the requested locale category, | ||||
546 | # l10n is disabled completely. This matches the behavior of GNU | ||||
547 | # gettext. | ||||
548 | 35811 | 24.5ms | 35811 | 128ms | if ($category != LC_MESSAGES) { # spent 128ms making 35811 calls to Locale::gettext_pp::LC_MESSAGES, avg 4µs/call |
549 | # Not supported. | ||||
550 | return []; | ||||
551 | } | ||||
552 | |||||
553 | 35811 | 9.09ms | if (!defined $locale && $category != 1729) { | ||
554 | $locale = POSIX::setlocale ($category); | ||||
555 | if (!defined $locale || 'C' eq $locale || 'POSIX' eq $locale) { | ||||
556 | return []; | ||||
557 | } | ||||
558 | } | ||||
559 | |||||
560 | 35811 | 6.82ms | $domainname = $__gettext_pp_textdomain | ||
561 | unless defined $domainname && length $domainname; | ||||
562 | |||||
563 | 35811 | 37.8ms | 35811 | 83.1ms | my $dir = bindtextdomain ($domainname, ''); # spent 83.1ms making 35811 calls to Locale::gettext_pp::bindtextdomain, avg 2µs/call |
564 | 35811 | 5.65ms | $dir = $__gettext_pp_default_dir unless defined $dir && length $dir; | ||
565 | |||||
566 | 35811 | 5.38ms | return [] unless defined $dir && length $dir; | ||
567 | |||||
568 | 35811 | 39.4ms | 35811 | 109ms | my ($cache_key, @locales) = __selected_locales $locale, $category, $category_name; # spent 109ms making 35811 calls to Locale::gettext_pp::__selected_locales, avg 3µs/call |
569 | |||||
570 | # Have we looked that one up already? | ||||
571 | 35811 | 35.3ms | my $domains = $__gettext_pp_domain_cache->{$dir}->{$cache_key}->{$category_name}->{$domainname}; | ||
572 | 35811 | 95.2ms | return $domains if defined $domains; | ||
573 | 24 | 5µs | return [] unless @locales; | ||
574 | |||||
575 | 24 | 11µs | my @dirs = ($dir); | ||
576 | 24 | 33µs | 24 | 356µs | my ($tries, $lookup) = __extend_locales @locales; # spent 356µs making 24 calls to Locale::gettext_pp::__extend_locales, avg 15µs/call |
577 | |||||
578 | 24 | 9µs | push @dirs, $__gettext_pp_default_dir | ||
579 | if $__gettext_pp_default_dir && $dir ne $__gettext_pp_default_dir; | ||||
580 | |||||
581 | 24 | 5µs | my %seen; | ||
582 | my %loaded; | ||||
583 | 24 | 14µs | foreach my $basedir (@dirs) { | ||
584 | 24 | 22µs | foreach my $try (@$tries) { | ||
585 | # If we had already found a catalog for "xy_XY", do not try it | ||||
586 | # again. | ||||
587 | 53 | 23µs | next if $loaded{$try}; | ||
588 | |||||
589 | 30 | 497µs | 120 | 512µs | my $fulldir = File::Spec->catfile($basedir, $try, $category_name); # spent 347µs making 30 calls to File::Spec::Unix::catfile, avg 12µs/call
# spent 109µs making 30 calls to File::Spec::Unix::catdir, avg 4µs/call
# spent 56µs making 60 calls to File::Spec::Unix::canonpath, avg 932ns/call |
590 | 30 | 30µs | next if $seen{$fulldir}++; | ||
591 | |||||
592 | # If the cache for unavailable directories is removed, | ||||
593 | # the three lines below should be replaced by: | ||||
594 | # 'next unless -d $fulldir;' | ||||
595 | 29 | 14µs | next if $__gettext_pp_unavailable_dirs->{$fulldir}; | ||
596 | 28 | 386µs | 28 | 328µs | ++$__gettext_pp_unavailable_dirs->{$fulldir} and next # spent 328µs making 28 calls to Locale::gettext_pp::CORE:ftdir, avg 12µs/call |
597 | unless -d $fulldir; | ||||
598 | 25 | 6.00ms | 100 | 11.8ms | my $filename = File::Spec->catfile($fulldir, "$domainname.mo"); # spent 5.94ms making 25 calls to File::Spec::Unix::catfile, avg 238µs/call
# spent 5.83ms making 25 calls to File::Spec::Unix::catdir, avg 233µs/call
# spent 27µs making 50 calls to File::Spec::Unix::canonpath, avg 536ns/call |
599 | 25 | 40µs | 25 | 165ms | my $domain = __load_catalog $filename, $try; # spent 165ms making 25 calls to Locale::gettext_pp::__load_catalog, avg 6.62ms/call |
600 | 25 | 5µs | next unless $domain; | ||
601 | |||||
602 | 25 | 18µs | $loaded{$try} = 1; | ||
603 | |||||
604 | 25 | 22µs | $domain->{locale_id} = $lookup->{$try}; | ||
605 | 25 | 37µs | push @$domains, $domain; | ||
606 | } | ||||
607 | } | ||||
608 | |||||
609 | 24 | 6µs | $domains = [] unless defined $domains; | ||
610 | |||||
611 | $__gettext_pp_domain_cache->{$dir} | ||||
612 | ->{$cache_key} | ||||
613 | ->{$category_name} | ||||
614 | 24 | 40µs | ->{$domainname} = $domains; | ||
615 | |||||
616 | 24 | 108µs | return $domains; | ||
617 | } | ||||
618 | |||||
619 | sub __load_catalog | ||||
620 | # spent 165ms (148+17.4) within Locale::gettext_pp::__load_catalog which was called 25 times, avg 6.62ms/call:
# 25 times (148ms+17.4ms) by Locale::gettext_pp::__load_domain at line 599, avg 6.62ms/call | ||||
621 | 25 | 18µs | my ($filename, $locale) = @_; | ||
622 | |||||
623 | # Alternatively we could check the filename for evil characters ... | ||||
624 | # (Important for CGIs). | ||||
625 | 25 | 493µs | 50 | 411µs | return unless -f $filename && -r $filename; # spent 216µs making 25 calls to Locale::gettext_pp::CORE:ftfile, avg 9µs/call
# spent 195µs making 25 calls to Locale::gettext_pp::CORE:fteread, avg 8µs/call |
626 | |||||
627 | 25 | 29µs | local $/; | ||
628 | 25 | 25µs | local *HANDLE; | ||
629 | |||||
630 | 25 | 469µs | 25 | 407µs | open HANDLE, "<$filename" # spent 407µs making 25 calls to Locale::gettext_pp::CORE:open, avg 16µs/call |
631 | or return; | ||||
632 | 25 | 66µs | 25 | 26µs | binmode HANDLE; # spent 26µs making 25 calls to Locale::gettext_pp::CORE:binmode, avg 1µs/call |
633 | 25 | 3.13ms | 25 | 3.08ms | my $raw = <HANDLE>; # spent 3.08ms making 25 calls to Locale::gettext_pp::CORE:readline, avg 123µs/call |
634 | 25 | 112µs | 25 | 77µs | close HANDLE; # spent 77µs making 25 calls to Locale::gettext_pp::CORE:close, avg 3µs/call |
635 | |||||
636 | # Corrupted? | ||||
637 | 25 | 16µs | return if ! defined $raw || length $raw < 28; | ||
638 | |||||
639 | 25 | 9µs | my $filesize = length $raw; | ||
640 | |||||
641 | # Read the magic number in order to determine the byte order. | ||||
642 | 25 | 44µs | my $domain = { | ||
643 | filename => $filename | ||||
644 | }; | ||||
645 | 25 | 8µs | my $unpack = 'N'; | ||
646 | 25 | 101µs | 25 | 31µs | $domain->{magic} = unpack $unpack, substr $raw, 0, 4; # spent 31µs making 25 calls to Locale::gettext_pp::CORE:unpack, avg 1µs/call |
647 | |||||
648 | 25 | 23µs | if ($domain->{magic} == 0xde120495) { | ||
649 | $unpack = 'V'; | ||||
650 | } elsif ($domain->{magic} != 0x950412de) { | ||||
651 | return; | ||||
652 | } | ||||
653 | 25 | 26µs | my $domain_unpack = $unpack x 6; | ||
654 | |||||
655 | 25 | 75µs | 25 | 16µs | my ($revision, $num_strings, $msgids_off, $msgstrs_off, # spent 16µs making 25 calls to Locale::gettext_pp::CORE:unpack, avg 652ns/call |
656 | $hash_size, $hash_off) = | ||||
657 | unpack (($unpack x 6), substr $raw, 4, 24); | ||||
658 | |||||
659 | 25 | 7µs | my $major = $revision >> 16; | ||
660 | 25 | 5µs | return if $major != 0; # Invalid revision number. | ||
661 | |||||
662 | 25 | 11µs | $domain->{revision} = $revision; | ||
663 | 25 | 16µs | $domain->{num_strings} = $num_strings; | ||
664 | 25 | 16µs | $domain->{msgids_off} = $msgids_off; | ||
665 | 25 | 10µs | $domain->{msgstrs_off} = $msgstrs_off; | ||
666 | 25 | 22µs | $domain->{hash_size} = $hash_size; | ||
667 | 25 | 5µs | $domain->{hash_off} = $hash_off; | ||
668 | |||||
669 | 25 | 11µs | return if $msgids_off + 4 * $num_strings > $filesize; | ||
670 | 25 | 6µs | return if $msgstrs_off + 4 * $num_strings > $filesize; | ||
671 | |||||
672 | 25 | 5.47ms | 25 | 4.78ms | my @orig_tab = unpack (($unpack x (2 * $num_strings)), # spent 4.78ms making 25 calls to Locale::gettext_pp::CORE:unpack, avg 191µs/call |
673 | substr $raw, $msgids_off, 8 * $num_strings); | ||||
674 | 25 | 5.62ms | 25 | 4.96ms | my @trans_tab = unpack (($unpack x (2 * $num_strings)), # spent 4.96ms making 25 calls to Locale::gettext_pp::CORE:unpack, avg 198µs/call |
675 | substr $raw, $msgstrs_off, 8 * $num_strings); | ||||
676 | |||||
677 | 25 | 14µs | my $messages = {}; | ||
678 | |||||
679 | 25 | 10.5ms | for (my $count = 0; $count < 2 * $num_strings; $count += 2) { | ||
680 | 44000 | 6.07ms | my $orig_length = $orig_tab[$count]; | ||
681 | 44000 | 6.53ms | my $orig_offset = $orig_tab[$count + 1]; | ||
682 | 44000 | 6.02ms | my $trans_length = $trans_tab[$count]; | ||
683 | 44000 | 6.24ms | my $trans_offset = $trans_tab[$count + 1]; | ||
684 | |||||
685 | 44000 | 5.43ms | return if $orig_offset + $orig_length > $filesize; | ||
686 | 44000 | 4.43ms | return if $trans_offset + $trans_length > $filesize; | ||
687 | |||||
688 | 44000 | 17.9ms | my @origs = split /\000/, substr $raw, $orig_offset, $orig_length; | ||
689 | 44000 | 17.8ms | my @trans = split /\000/, substr $raw, $trans_offset, $trans_length; | ||
690 | |||||
691 | # The singular is the key, the plural plus all translations is the | ||||
692 | # value. | ||||
693 | 44000 | 6.32ms | my $msgid = $origs[0]; | ||
694 | 44000 | 5.63ms | $msgid = '' unless defined $msgid && length $msgid; | ||
695 | 44000 | 17.2ms | my $msgstr = [ $origs[1], @trans ]; | ||
696 | 44000 | 27.6ms | $messages->{$msgid} = $msgstr; | ||
697 | } | ||||
698 | |||||
699 | 25 | 18µs | $domain->{messages} = $messages; | ||
700 | |||||
701 | # Try to find po header information. | ||||
702 | 25 | 11µs | my $po_header = {}; | ||
703 | 25 | 18µs | my $null_entry = $messages->{''}->[1]; | ||
704 | 25 | 10µs | if ($null_entry) { | ||
705 | 25 | 53µs | my @lines = split /\n/, $null_entry; | ||
706 | 25 | 32µs | foreach my $line (@lines) { | ||
707 | 272 | 179µs | my ($key, $value) = split /:/, $line, 2; | ||
708 | 272 | 5.16ms | 272 | 259µs | $key =~ s/-/_/g; # spent 259µs making 272 calls to Locale::gettext_pp::CORE:subst, avg 952ns/call |
709 | 272 | 243µs | $po_header->{lc $key} = $value; | ||
710 | } | ||||
711 | } | ||||
712 | 25 | 21µs | $domain->{po_header} = $po_header; | ||
713 | |||||
714 | 25 | 18µs | if (exists $domain->{po_header}->{content_type}) { | ||
715 | 25 | 17µs | my $content_type = $domain->{po_header}->{content_type}; | ||
716 | 25 | 123µs | 25 | 72µs | if ($content_type =~ s/.*=//) { # spent 72µs making 25 calls to Locale::gettext_pp::CORE:subst, avg 3µs/call |
717 | $domain->{po_header}->{charset} = $content_type; | ||||
718 | } | ||||
719 | } | ||||
720 | |||||
721 | 25 | 12µs | my $code = $domain->{po_header}->{plural_forms} || ''; | ||
722 | |||||
723 | # Whitespace, locale-independent. | ||||
724 | 25 | 6µs | my $s = '[ \011-\015]'; | ||
725 | |||||
726 | # Untaint the plural header. | ||||
727 | # Keep line breaks as is (Perl 5_005 compatibility). | ||||
728 | $code = $domain->{po_header}->{plural_forms} | ||||
729 | 25 | 64µs | 25 | 468µs | = __untaint_plural_header $code; # spent 468µs making 25 calls to Locale::gettext_pp::__untaint_plural_header, avg 19µs/call |
730 | |||||
731 | 25 | 48µs | 25 | 2.53ms | $domain->{plural_func} = __compile_plural_function $code; # spent 2.53ms making 25 calls to Locale::gettext_pp::__compile_plural_function, avg 101µs/call |
732 | |||||
733 | 25 | 120µs | 25 | 69µs | unless (defined $domain->{po_header}->{charset} # spent 69µs making 25 calls to Locale::gettext_pp::CORE:match, avg 3µs/call |
734 | && length $domain->{po_header}->{charset} | ||||
735 | && $locale =~ /^(?:[a-z][a-z]) | ||||
736 | (?:(?:_[A-Z][A-Z])? | ||||
737 | (\.[-_A-Za-z0-9]+)? | ||||
738 | )? | ||||
739 | (?:\@[-_A-Za-z0-9]+)?$/x) { | ||||
740 | $domain->{po_header}->{charset} = $1; | ||||
741 | } | ||||
742 | |||||
743 | 25 | 128µs | 25 | 225µs | if (defined $domain->{po_header}->{charset}) { # spent 225µs making 25 calls to Locale::Recode::resolveAlias, avg 9µs/call |
744 | $domain->{po_header}->{charset} = | ||||
745 | Locale::Recode->resolveAlias ($domain->{po_header}->{charset}); | ||||
746 | } | ||||
747 | |||||
748 | 25 | 2.34ms | return $domain; | ||
749 | } | ||||
750 | |||||
751 | sub __locale_category | ||||
752 | { | ||||
753 | my ($category, $category_name) = @_; | ||||
754 | |||||
755 | local $@; | ||||
756 | my $value = eval {POSIX::setlocale ($category)}; | ||||
757 | |||||
758 | # We support only XPG syntax, i. e. | ||||
759 | # language[_territory[.codeset]][@modifier]. | ||||
760 | undef $value unless (defined $value && | ||||
761 | length $value && | ||||
762 | $value =~ /^[a-z][a-z] | ||||
763 | (?:_[A-Z][A-Z] | ||||
764 | (?:\.[-_A-Za-z0-9]+)? | ||||
765 | )? | ||||
766 | (?:\@[-_A-Za-z0-9]+)?$/x); | ||||
767 | |||||
768 | unless ($value) { | ||||
769 | $value = $ENV{LC_ALL}; | ||||
770 | $value = $ENV{$category_name} unless defined $value && length $value; | ||||
771 | $value = $ENV{LANG} unless defined $value && length $value; | ||||
772 | return 'C' unless defined $value && length $value; | ||||
773 | } | ||||
774 | |||||
775 | return $value if $value ne 'C' && $value ne 'POSIX'; | ||||
776 | } | ||||
777 | |||||
778 | sub __get_codeset | ||||
779 | { | ||||
780 | my ($category, $category_name, $locale_id) = @_; | ||||
781 | |||||
782 | local $@; | ||||
783 | unless (defined $has_nl_langinfo) { | ||||
784 | eval { | ||||
785 | require I18N::Langinfo; | ||||
786 | }; | ||||
787 | $has_nl_langinfo = !$@; | ||||
788 | } | ||||
789 | |||||
790 | if ($has_nl_langinfo) { | ||||
791 | # Try to set the locale via the specified id. | ||||
792 | my $saved_locale = eval { POSIX::setlocale (LC_ALL) }; | ||||
793 | my $had_lc_all = exists $ENV{LC_ALL}; | ||||
794 | my $saved_lc_all = $ENV{LC_ALL} if $had_lc_all; | ||||
795 | |||||
796 | # Now try to set the locale via the environment. There is no | ||||
797 | # point in calling the langinfo routines if this fails. | ||||
798 | $ENV{LC_ALL} = $locale_id; | ||||
799 | my $codeset; | ||||
800 | my $lc_all = eval { POSIX::setlocale (LC_ALL, $locale_id); }; | ||||
801 | $codeset = I18N::Langinfo::langinfo (I18N::Langinfo::CODESET()) | ||||
802 | if defined $lc_all; | ||||
803 | |||||
804 | # Restore environment. | ||||
805 | if ($saved_locale) { | ||||
806 | eval { POSIX::setlocale (LC_ALL, $saved_locale); } | ||||
807 | } | ||||
808 | if ($had_lc_all) { | ||||
809 | $ENV{LC_ALL} = $saved_lc_all if $had_lc_all; | ||||
810 | } else { | ||||
811 | delete $ENV{LC_ALL}; | ||||
812 | } | ||||
813 | return $codeset; | ||||
814 | } | ||||
815 | |||||
816 | return; | ||||
817 | } | ||||
818 | |||||
819 | # spent 468µs (196+272) within Locale::gettext_pp::__untaint_plural_header which was called 25 times, avg 19µs/call:
# 25 times (196µs+272µs) by Locale::gettext_pp::__load_catalog at line 729, avg 19µs/call | ||||
820 | 25 | 12µs | my ($code) = @_; | ||
821 | |||||
822 | # Whitespace, locale-independent. | ||||
823 | 25 | 13µs | my $s = '[ \t\r\n\013\014]'; | ||
824 | |||||
825 | 25 | 450µs | 50 | 272µs | if ($code =~ m{^($s* # spent 147µs making 25 calls to Locale::gettext_pp::CORE:regcomp, avg 6µs/call
# spent 125µs making 25 calls to Locale::gettext_pp::CORE:match, avg 5µs/call |
826 | nplurals$s*=$s*[0-9]+ | ||||
827 | $s*;$s* | ||||
828 | plural$s*=$s*(?:$s|[-\?\|\&=!<>+*/\%:;a-zA-Z0-9_\(\)])+ | ||||
829 | )}xms) { | ||||
830 | return $1; | ||||
831 | } | ||||
832 | |||||
833 | return ''; | ||||
834 | } | ||||
835 | |||||
836 | # spent 2.53ms (2.39+147µs) within Locale::gettext_pp::__compile_plural_function which was called 25 times, avg 101µs/call:
# 25 times (2.39ms+147µs) by Locale::gettext_pp::__load_catalog at line 731, avg 101µs/call | ||||
837 | 25 | 7µs | my ($code) = @_; | ||
838 | |||||
839 | # The leading and trailing space is necessary to be able to match | ||||
840 | # against word boundaries. | ||||
841 | 25 | 7µs | my $plural_func; | ||
842 | |||||
843 | 25 | 13µs | if (length $code) { | ||
844 | 25 | 12µs | my $code = ' ' . $code . ' '; | ||
845 | 25 | 344µs | 130 | 147µs | $code =~ # spent 96µs making 105 calls to Locale::gettext_pp::CORE:substcont, avg 919ns/call
# spent 50µs making 25 calls to Locale::gettext_pp::CORE:subst, avg 2µs/call |
846 | s/(?<=[^_a-zA-Z0-9])[_a-z][_A-Za-z0-9]*(?=[^_a-zA-Z0-9])/\$$&/gs; | ||||
847 | |||||
848 | 25 | 17µs | $code = "sub { my \$n = shift || 0; | ||
849 | my (\$plural, \$nplurals); | ||||
850 | $code; | ||||
851 | return (\$nplurals, \$plural ? \$plural : 0); }"; | ||||
852 | |||||
853 | # Now try to evaluate the code. There is no need to run the code in | ||||
854 | # a Safe compartment. The above substitutions should have destroyed | ||||
855 | # all evil code. Corrections are welcome! | ||||
856 | #warn $code; | ||||
857 | 25 | 1.96ms | $plural_func = eval $code; # spent 55µs executing statements in 12 string evals (merged)
# spent 30µs executing statements in 6 string evals (merged)
# spent 14µs executing statements in 3 string evals (merged)
# spent 6µs executing statements in string eval
# spent 5µs executing statements in string eval
# spent 4µs executing statements in string eval
# spent 4µs executing statements in string eval | ||
858 | #warn $@ if $@; | ||||
859 | 25 | 15µs | undef $plural_func if $@; | ||
860 | } | ||||
861 | |||||
862 | # Default is Germanic plural (which is incorrect for French). | ||||
863 | 25 | 7µs | $plural_func = eval "sub { (2, 1 != shift || 0) }" unless $plural_func; | ||
864 | |||||
865 | 25 | 57µs | return $plural_func; | ||
866 | } | ||||
867 | |||||
868 | 1; | ||||
869 | |||||
870 | __END__ | ||||
# spent 26µs within Locale::gettext_pp::CORE:binmode which was called 25 times, avg 1µs/call:
# 25 times (26µs+0s) by Locale::gettext_pp::__load_catalog at line 632, avg 1µs/call | |||||
# spent 77µs within Locale::gettext_pp::CORE:close which was called 25 times, avg 3µs/call:
# 25 times (77µs+0s) by Locale::gettext_pp::__load_catalog at line 634, avg 3µs/call | |||||
# spent 328µs within Locale::gettext_pp::CORE:ftdir which was called 28 times, avg 12µs/call:
# 28 times (328µs+0s) by Locale::gettext_pp::__load_domain at line 596, avg 12µs/call | |||||
# spent 195µs within Locale::gettext_pp::CORE:fteread which was called 25 times, avg 8µs/call:
# 25 times (195µs+0s) by Locale::gettext_pp::__load_catalog at line 625, avg 8µs/call | |||||
# spent 216µs within Locale::gettext_pp::CORE:ftfile which was called 25 times, avg 9µs/call:
# 25 times (216µs+0s) by Locale::gettext_pp::__load_catalog at line 625, avg 9µs/call | |||||
# spent 255µs within Locale::gettext_pp::CORE:match which was called 74 times, avg 3µs/call:
# 25 times (125µs+0s) by Locale::gettext_pp::__untaint_plural_header at line 825, avg 5µs/call
# 25 times (69µs+0s) by Locale::gettext_pp::__load_catalog at line 733, avg 3µs/call
# 24 times (61µs+0s) by Locale::gettext_pp::__extend_locales at line 517, avg 3µs/call | |||||
# spent 407µs within Locale::gettext_pp::CORE:open which was called 25 times, avg 16µs/call:
# 25 times (407µs+0s) by Locale::gettext_pp::__load_catalog at line 630, avg 16µs/call | |||||
# spent 3.08ms within Locale::gettext_pp::CORE:readline which was called 25 times, avg 123µs/call:
# 25 times (3.08ms+0s) by Locale::gettext_pp::__load_catalog at line 633, avg 123µs/call | |||||
# spent 147µs within Locale::gettext_pp::CORE:regcomp which was called 25 times, avg 6µs/call:
# 25 times (147µs+0s) by Locale::gettext_pp::__untaint_plural_header at line 825, avg 6µs/call | |||||
# spent 382µs within Locale::gettext_pp::CORE:subst which was called 322 times, avg 1µs/call:
# 272 times (259µs+0s) by Locale::gettext_pp::__load_catalog at line 708, avg 952ns/call
# 25 times (72µs+0s) by Locale::gettext_pp::__load_catalog at line 716, avg 3µs/call
# 25 times (50µs+0s) by Locale::gettext_pp::__compile_plural_function at line 845, avg 2µs/call | |||||
# spent 96µs within Locale::gettext_pp::CORE:substcont which was called 105 times, avg 919ns/call:
# 105 times (96µs+0s) by Locale::gettext_pp::__compile_plural_function at line 845, avg 919ns/call | |||||
# spent 9.79ms within Locale::gettext_pp::CORE:unpack which was called 100 times, avg 98µs/call:
# 25 times (4.96ms+0s) by Locale::gettext_pp::__load_catalog at line 674, avg 198µs/call
# 25 times (4.78ms+0s) by Locale::gettext_pp::__load_catalog at line 672, avg 191µs/call
# 25 times (31µs+0s) by Locale::gettext_pp::__load_catalog at line 646, avg 1µs/call
# 25 times (16µs+0s) by Locale::gettext_pp::__load_catalog at line 655, avg 652ns/call |