← Index
NYTProf Performance Profile   « line view »
For /usr/local/libexec/sympa/task_manager-debug.pl
  Run on Tue Jun 1 22:32:51 2021
Reported on Tue Jun 1 22:35:07 2021

Filename/usr/local/lib/perl5/site_perl/Locale/gettext_pp.pm
StatementsExecuted 2601750 statements in 1.53s
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
3581111704ms1.95sLocale::gettext_pp::::_dcnpgettext_implLocale::gettext_pp::_dcnpgettext_impl
3581111504ms996msLocale::gettext_pp::::__load_domainLocale::gettext_pp::__load_domain
2511148ms165msLocale::gettext_pp::::__load_catalogLocale::gettext_pp::__load_catalog
3581111109ms109msLocale::gettext_pp::::__selected_localesLocale::gettext_pp::__selected_locales
358111183.1ms83.1msLocale::gettext_pp::::bindtextdomainLocale::gettext_pp::bindtextdomain
346611172.6ms72.6msLocale::gettext_pp::::textdomainLocale::gettext_pp::textdomain
100419.79ms9.79msLocale::gettext_pp::::CORE:unpackLocale::gettext_pp::CORE:unpack (opcode)
25113.08ms3.08msLocale::gettext_pp::::CORE:readlineLocale::gettext_pp::CORE:readline (opcode)
25112.39ms2.53msLocale::gettext_pp::::__compile_plural_functionLocale::gettext_pp::__compile_plural_function
2511407µs407µsLocale::gettext_pp::::CORE:openLocale::gettext_pp::CORE:open (opcode)
32231382µs382µsLocale::gettext_pp::::CORE:substLocale::gettext_pp::CORE:subst (opcode)
2811328µs328µsLocale::gettext_pp::::CORE:ftdirLocale::gettext_pp::CORE:ftdir (opcode)
2411295µs356µsLocale::gettext_pp::::__extend_localesLocale::gettext_pp::__extend_locales
7431255µs255µsLocale::gettext_pp::::CORE:matchLocale::gettext_pp::CORE:match (opcode)
2511216µs216µsLocale::gettext_pp::::CORE:ftfileLocale::gettext_pp::CORE:ftfile (opcode)
2511196µs468µsLocale::gettext_pp::::__untaint_plural_headerLocale::gettext_pp::__untaint_plural_header
2511195µs195µsLocale::gettext_pp::::CORE:ftereadLocale::gettext_pp::CORE:fteread (opcode)
2511147µs147µsLocale::gettext_pp::::CORE:regcompLocale::gettext_pp::CORE:regcomp (opcode)
1051196µs96µsLocale::gettext_pp::::CORE:substcontLocale::gettext_pp::CORE:substcont (opcode)
251177µs77µsLocale::gettext_pp::::CORE:closeLocale::gettext_pp::CORE:close (opcode)
251126µs26µsLocale::gettext_pp::::CORE:binmodeLocale::gettext_pp::CORE:binmode (opcode)
0000s0sLocale::gettext_pp::::BEGIN@123Locale::gettext_pp::BEGIN@123
0000s0sLocale::gettext_pp::::BEGIN@24Locale::gettext_pp::BEGIN@24
0000s0sLocale::gettext_pp::::BEGIN@28Locale::gettext_pp::BEGIN@28
0000s0sLocale::gettext_pp::::BEGIN@39Locale::gettext_pp::BEGIN@39
0000s0sLocale::gettext_pp::::BEGIN@40Locale::gettext_pp::BEGIN@40
0000s0sLocale::gettext_pp::::BEGIN@41Locale::gettext_pp::BEGIN@41
0000s0sLocale::gettext_pp::::BEGIN@43Locale::gettext_pp::BEGIN@43
0000s0sLocale::gettext_pp::::BEGIN@65Locale::gettext_pp::BEGIN@65
0000s0sLocale::gettext_pp::::BEGIN@68Locale::gettext_pp::BEGIN@68
0000s0sLocale::gettext_pp::::LC_ALLLocale::gettext_pp::LC_ALL
0000s0sLocale::gettext_pp::::LC_COLLATELocale::gettext_pp::LC_COLLATE
0000s0sLocale::gettext_pp::::LC_CTYPELocale::gettext_pp::LC_CTYPE
0000s0sLocale::gettext_pp::::LC_MONETARYLocale::gettext_pp::LC_MONETARY
0000s0sLocale::gettext_pp::::LC_NUMERICLocale::gettext_pp::LC_NUMERIC
0000s0sLocale::gettext_pp::::LC_TIMELocale::gettext_pp::LC_TIME
0000s0sLocale::gettext_pp::::__ANON__Locale::gettext_pp::__ANON__ (xsub)
0000s0sLocale::gettext_pp::::__get_codesetLocale::gettext_pp::__get_codeset
0000s0sLocale::gettext_pp::::__locale_categoryLocale::gettext_pp::__locale_category
0000s0sLocale::gettext_pp::::bind_textdomain_codesetLocale::gettext_pp::bind_textdomain_codeset
0000s0sLocale::gettext_pp::::dcgettextLocale::gettext_pp::dcgettext
0000s0sLocale::gettext_pp::::dcngettextLocale::gettext_pp::dcngettext
0000s0sLocale::gettext_pp::::dcnpgettextLocale::gettext_pp::dcnpgettext
0000s0sLocale::gettext_pp::::dcpgettextLocale::gettext_pp::dcpgettext
0000s0sLocale::gettext_pp::::dgettextLocale::gettext_pp::dgettext
0000s0sLocale::gettext_pp::::dngettextLocale::gettext_pp::dngettext
0000s0sLocale::gettext_pp::::dnpgettextLocale::gettext_pp::dnpgettext
0000s0sLocale::gettext_pp::::dpgettextLocale::gettext_pp::dpgettext
0000s0sLocale::gettext_pp::::gettextLocale::gettext_pp::gettext
0000s0sLocale::gettext_pp::::ngettextLocale::gettext_pp::ngettext
0000s0sLocale::gettext_pp::::nl_putenvLocale::gettext_pp::nl_putenv
0000s0sLocale::gettext_pp::::npgettextLocale::gettext_pp::npgettext
0000s0sLocale::gettext_pp::::pgettextLocale::gettext_pp::pgettext
0000s0sLocale::gettext_pp::::setlocaleLocale::gettext_pp::setlocale
Call graph for these subroutines as a Graphviz dot language file.
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
22package Locale::gettext_pp;
23
24use strict;
25
26require 5.004;
27
28use 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
39use locale;
40use File::Spec;
41use Locale::Messages;
42
43BEGIN {
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
65BEGIN {
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) {
90eval <<'EOF';
# spent 426ms executing statements in string eval
# includes 239ms spent executing 71622 calls to 1 sub defined therein.
91sub LC_MESSAGES()
92{
93 local $!; # Do not clobber errno!
94
95 return &POSIX::LC_MESSAGES;
96}
97EOF
98 } elsif ($five_ok) {
99eval <<'EOF';
100sub 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}
108EOF
109 } else {
110eval <<'EOF';
111sub 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}
119EOF
120 }
121}
122
123use 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
179my $has_nl_langinfo;
180
181sub __load_catalog;
182sub __load_domain;
183sub __locale_category;
184sub __untaint_plural_header;
185sub __compile_plural_function;
186
187sub LC_NUMERIC()
188{
189 &POSIX::LC_NUMERIC;
190}
191
192sub LC_CTYPE()
193{
194 &POSIX::LC_CTYPE;
195}
196
197sub LC_TIME()
198{
199 &POSIX::LC_TIME;
200}
201
202sub LC_COLLATE()
203{
204 &POSIX::LC_COLLATE;
205}
206
207sub LC_MONETARY()
208{
209 &POSIX::LC_MONETARY;
210}
211
212sub LC_ALL()
213{
214 &POSIX::LC_ALL;
215}
216
217sub 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
{
219346618.01ms my $new_domain = shift;
220
221346616.54ms $__gettext_pp_textdomain = $new_domain if defined $new_domain &&
222 length $new_domain;
223
22434661103ms return $__gettext_pp_textdomain;
225}
226
227sub 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
{
2293581111.2ms my ($domain, $directory) = @_;
230
231358114.90ms my $retval;
232358117.98ms if (defined $domain && length $domain) {
2333581121.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 }
241358116.14ms $retval = '/usr/share/locale' unless defined $retval &&
242 length $retval;
24335811114ms return $retval;
244 } else {
245 return;
246 }
247}
248
249sub 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
264sub gettext($)
265{
266 my ($msgid) = @_;
267
268 return dcnpgettext ('', undef, $msgid, undef, undef, undef);
269}
270
271sub dgettext($$)
272{
273 my ($domainname, $msgid) = @_;
274
275 return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
276}
277
278sub dcgettext($$$)
279{
280 my ($domainname, $msgid, $category) = @_;
281
282 return dcnpgettext ($domainname, undef, $msgid, undef, undef, undef);
283}
284
285sub ngettext($$$)
286{
287 my ($msgid, $msgid_plural, $n) = @_;
288
289 return dcnpgettext ('', undef, $msgid, $msgid_plural, $n, undef);
290}
291
292sub dngettext($$$$)
293{
294 my ($domainname, $msgid, $msgid_plural, $n) = @_;
295
296 return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, undef);
297}
298
299sub dcngettext($$$$$)
300{
301 my ($domainname, $msgid, $msgid_plural, $n, $category) = @_;
302
303 return dcnpgettext ($domainname, undef, $msgid, $msgid_plural, $n, , $category);
304}
305
306
307sub pgettext($$)
308{
309 my ($msgctxt, $msgid) = @_;
310
311 return dcnpgettext ('', $msgctxt, $msgid, undef, undef, undef);
312}
313
314sub dpgettext($$$)
315{
316 my ($domainname, $msgctxt, $msgid) = @_;
317
318 return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
319}
320
321sub dcpgettext($$$$)
322{
323 my ($domainname, $msgctxt, $msgid, $category) = @_;
324
325 return dcnpgettext ($domainname, $msgctxt, $msgid, undef, undef, undef);
326}
327
328sub npgettext($$$$)
329{
330 my ($msgctxt, $msgid, $msgid_plural, $n) = @_;
331
332 return dcnpgettext ('', $msgctxt, $msgid, $msgid_plural, $n, undef);
333}
334
335sub 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
sub _dcnpgettext_impl {
3453581117.9ms my ($domainname, $msgctxt, $msgid, $msgid_plural, $n, $category,
346 $locale) = @_;
347
348358116.89ms return unless defined $msgid;
349
350358119.21ms my $plural = defined $msgid_plural;
3513581126.0ms35811111ms Locale::Messages::turn_utf_8_off($msgid);
# spent 111ms making 35811 calls to Locale::Messages::turn_utf_8_off, avg 3µs/call
352358115.69ms Locale::Messages::turn_utf_8_off($msgctxt) if defined $msgctxt;
353358119.12ms my $msg_ctxt_id = defined $msgctxt ? join($__gettext_pp_context_glue, ($msgctxt, $msgid)) : $msgid;
354
3553581162.4ms local $!; # Do not clobber errno!
356
357 # This is also done in __load_domain but we need a proper value.
3583581112.0ms $domainname = $__gettext_pp_textdomain
359 unless defined $domainname && length $domainname;
360
361 # Category is always LC_MESSAGES (other categories are ignored).
362358117.17ms my $category_name = 'LC_MESSAGES';
3633581133.4ms35811137ms $category = LC_MESSAGES;
# spent 137ms making 35811 calls to Locale::gettext_pp::LC_MESSAGES, avg 4µs/call
364
3653581139.3ms35811996ms 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
368358119.11ms my @trans = ();
369358114.56ms my $domain;
370 my $found;
3713581112.4ms foreach my $this_domain (@$domains) {
3723581129.6ms if ($this_domain && defined $this_domain->{messages}->{$msg_ctxt_id}) {
3733558122.6ms @trans = @{$this_domain->{messages}->{$msg_ctxt_id}};
374355817.29ms shift @trans;
375355815.55ms $domain = $this_domain;
376355815.49ms $found = 1;
377355817.54ms last;
378 }
379 }
380358115.99ms @trans = ($msgid, $msgid_plural) unless @trans;
381
382358117.33ms my $trans = $trans[0];
383358116.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
3973581119.2ms if ($found && defined $domain->{po_header}->{charset}) {
3983558111.8ms my $input_codeset = $domain->{po_header}->{charset};
399 # Convert into output charset.
4003558111.5ms my $output_codeset = $__gettext_pp_domain_codeset_bindings->{$domainname};
401
402355815.25ms $output_codeset = $ENV{OUTPUT_CHARSET} unless defined $output_codeset;
403 $output_codeset = __get_codeset ($category, $category_name,
404 $domain->{locale_id})
405355814.71ms unless defined $output_codeset;
406
407355813.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}
417355814.34ms unless defined $output_codeset;
418
4193558114.6ms if (exists $__gettext_pp_domain_cache->{$output_codeset}) {
420 $output_codeset = $__gettext_pp_domain_cache->{$output_codeset};
421 } else {
42211µs $output_codeset = 'utf-8' if lc $output_codeset eq 'utf8';
423 $output_codeset =
42413µs15µ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
4283558120.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
44835811130ms return $trans;
449}
450
451sub dcnpgettext ($$$$$$) {
452 return &_dcnpgettext_impl;
453}
454
455sub 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
485sub 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
sub __selected_locales {
4913581112.8ms my ($locale, $category, $category_name) = @_;
492
493358114.55ms my @locales;
494 my $cache_key;
495
4963581117.5ms if (defined $ENV{LANGUAGE} && length $ENV{LANGUAGE}) {
4973581127.5ms @locales = split /:/, $ENV{LANGUAGE};
498358119.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
50735811149ms 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
sub __extend_locales {
5112410µs my (@locales) = @_;
512
5132414µs my @tries = @locales;
5142446µs my %locale_lookup = map { $_ => $_ } @tries;
515
5162412µs foreach my $locale (@locales) {
51724135µs2461µ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
5232422µs if (defined $3) {
524 defined $2 ?
525 push @tries, $1 . $2 . $3 : push @tries, $1 . $3;
526 $locale_lookup{$tries[-1]} = $locale;
527 }
5282414µs if (defined $2) {
52957µs push @tries, $1 . $2;
53055µs $locale_lookup{$1 . $2} = $locale;
531 }
5322414µs if (defined $1) {
5332416µs push @tries, $1 if defined $1;
5342423µs $locale_lookup{$1} = $locale;
535 }
536 }
537 }
538
5392455µ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
sub __load_domain {
5433581115.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.
5483581124.5ms35811128ms 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
553358119.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
560358116.82ms $domainname = $__gettext_pp_textdomain
561 unless defined $domainname && length $domainname;
562
5633581137.8ms3581183.1ms my $dir = bindtextdomain ($domainname, '');
# spent 83.1ms making 35811 calls to Locale::gettext_pp::bindtextdomain, avg 2µs/call
564358115.65ms $dir = $__gettext_pp_default_dir unless defined $dir && length $dir;
565
566358115.38ms return [] unless defined $dir && length $dir;
567
5683581139.4ms35811109ms 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?
5713581135.3ms my $domains = $__gettext_pp_domain_cache->{$dir}->{$cache_key}->{$category_name}->{$domainname};
5723581195.2ms return $domains if defined $domains;
573245µs return [] unless @locales;
574
5752411µs my @dirs = ($dir);
5762433µs24356µs my ($tries, $lookup) = __extend_locales @locales;
# spent 356µs making 24 calls to Locale::gettext_pp::__extend_locales, avg 15µs/call
577
578249µs push @dirs, $__gettext_pp_default_dir
579 if $__gettext_pp_default_dir && $dir ne $__gettext_pp_default_dir;
580
581245µs my %seen;
582 my %loaded;
5832414µs foreach my $basedir (@dirs) {
5842422µs foreach my $try (@$tries) {
585 # If we had already found a catalog for "xy_XY", do not try it
586 # again.
5875323µs next if $loaded{$try};
588
58930497µs120512µ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
5903030µ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;'
5952914µs next if $__gettext_pp_unavailable_dirs->{$fulldir};
59628386µs28328µ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;
598256.00ms10011.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
5992540µs25165ms my $domain = __load_catalog $filename, $try;
# spent 165ms making 25 calls to Locale::gettext_pp::__load_catalog, avg 6.62ms/call
600255µs next unless $domain;
601
6022518µs $loaded{$try} = 1;
603
6042522µs $domain->{locale_id} = $lookup->{$try};
6052537µs push @$domains, $domain;
606 }
607 }
608
609246µs $domains = [] unless defined $domains;
610
611 $__gettext_pp_domain_cache->{$dir}
612 ->{$cache_key}
613 ->{$category_name}
6142440µs ->{$domainname} = $domains;
615
61624108µs return $domains;
617}
618
619sub __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
{
6212518µs my ($filename, $locale) = @_;
622
623 # Alternatively we could check the filename for evil characters ...
624 # (Important for CGIs).
62525493µs50411µ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
6272529µs local $/;
6282525µs local *HANDLE;
629
63025469µs25407µs open HANDLE, "<$filename"
# spent 407µs making 25 calls to Locale::gettext_pp::CORE:open, avg 16µs/call
631 or return;
6322566µs2526µs binmode HANDLE;
# spent 26µs making 25 calls to Locale::gettext_pp::CORE:binmode, avg 1µs/call
633253.13ms253.08ms my $raw = <HANDLE>;
# spent 3.08ms making 25 calls to Locale::gettext_pp::CORE:readline, avg 123µs/call
63425112µs2577µs close HANDLE;
# spent 77µs making 25 calls to Locale::gettext_pp::CORE:close, avg 3µs/call
635
636 # Corrupted?
6372516µs return if ! defined $raw || length $raw < 28;
638
639259µs my $filesize = length $raw;
640
641 # Read the magic number in order to determine the byte order.
6422544µs my $domain = {
643 filename => $filename
644 };
645258µs my $unpack = 'N';
64625101µs2531µ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
6482523µs if ($domain->{magic} == 0xde120495) {
649 $unpack = 'V';
650 } elsif ($domain->{magic} != 0x950412de) {
651 return;
652 }
6532526µs my $domain_unpack = $unpack x 6;
654
6552575µs2516µ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
659257µs my $major = $revision >> 16;
660255µs return if $major != 0; # Invalid revision number.
661
6622511µs $domain->{revision} = $revision;
6632516µs $domain->{num_strings} = $num_strings;
6642516µs $domain->{msgids_off} = $msgids_off;
6652510µs $domain->{msgstrs_off} = $msgstrs_off;
6662522µs $domain->{hash_size} = $hash_size;
667255µs $domain->{hash_off} = $hash_off;
668
6692511µs return if $msgids_off + 4 * $num_strings > $filesize;
670256µs return if $msgstrs_off + 4 * $num_strings > $filesize;
671
672255.47ms254.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);
674255.62ms254.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
6772514µs my $messages = {};
678
6792510.5ms for (my $count = 0; $count < 2 * $num_strings; $count += 2) {
680440006.07ms my $orig_length = $orig_tab[$count];
681440006.53ms my $orig_offset = $orig_tab[$count + 1];
682440006.02ms my $trans_length = $trans_tab[$count];
683440006.24ms my $trans_offset = $trans_tab[$count + 1];
684
685440005.43ms return if $orig_offset + $orig_length > $filesize;
686440004.43ms return if $trans_offset + $trans_length > $filesize;
687
6884400017.9ms my @origs = split /\000/, substr $raw, $orig_offset, $orig_length;
6894400017.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.
693440006.32ms my $msgid = $origs[0];
694440005.63ms $msgid = '' unless defined $msgid && length $msgid;
6954400017.2ms my $msgstr = [ $origs[1], @trans ];
6964400027.6ms $messages->{$msgid} = $msgstr;
697 }
698
6992518µs $domain->{messages} = $messages;
700
701 # Try to find po header information.
7022511µs my $po_header = {};
7032518µs my $null_entry = $messages->{''}->[1];
7042510µs if ($null_entry) {
7052553µs my @lines = split /\n/, $null_entry;
7062532µs foreach my $line (@lines) {
707272179µs my ($key, $value) = split /:/, $line, 2;
7082725.16ms272259µs $key =~ s/-/_/g;
# spent 259µs making 272 calls to Locale::gettext_pp::CORE:subst, avg 952ns/call
709272243µs $po_header->{lc $key} = $value;
710 }
711 }
7122521µs $domain->{po_header} = $po_header;
713
7142518µs if (exists $domain->{po_header}->{content_type}) {
7152517µs my $content_type = $domain->{po_header}->{content_type};
71625123µs2572µ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
7212512µs my $code = $domain->{po_header}->{plural_forms} || '';
722
723 # Whitespace, locale-independent.
724256µ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}
7292564µs25468µs = __untaint_plural_header $code;
# spent 468µs making 25 calls to Locale::gettext_pp::__untaint_plural_header, avg 19µs/call
730
7312548µs252.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
73325120µs2569µ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
74325128µs25225µ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
748252.34ms return $domain;
749}
750
751sub __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
778sub __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
sub __untaint_plural_header {
8202512µs my ($code) = @_;
821
822 # Whitespace, locale-independent.
8232513µs my $s = '[ \t\r\n\013\014]';
824
82525450µs50272µ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
sub __compile_plural_function {
837257µs my ($code) = @_;
838
839 # The leading and trailing space is necessary to be able to match
840 # against word boundaries.
841257µs my $plural_func;
842
8432513µs if (length $code) {
8442512µs my $code = ' ' . $code . ' ';
84525344µs130147µ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
8482517µ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;
857251.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 $@;
8592515µs undef $plural_func if $@;
860 }
861
862 # Default is Germanic plural (which is incorrect for French).
863257µs $plural_func = eval "sub { (2, 1 != shift || 0) }" unless $plural_func;
864
8652557µs return $plural_func;
866}
867
8681;
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
sub Locale::gettext_pp::CORE:binmode; # opcode
# 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
sub Locale::gettext_pp::CORE:close; # opcode
# 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
sub Locale::gettext_pp::CORE:ftdir; # opcode
# 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
sub Locale::gettext_pp::CORE:fteread; # opcode
# 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
sub Locale::gettext_pp::CORE:ftfile; # opcode
# 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
sub Locale::gettext_pp::CORE:match; # opcode
# 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
sub Locale::gettext_pp::CORE:open; # opcode
# 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
sub Locale::gettext_pp::CORE:readline; # opcode
# 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
sub Locale::gettext_pp::CORE:regcomp; # opcode
# 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
sub Locale::gettext_pp::CORE:subst; # opcode
# 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
sub Locale::gettext_pp::CORE:substcont; # opcode
# 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
sub Locale::gettext_pp::CORE:unpack; # opcode