← 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/Recode.pm
StatementsExecuted 52 statements in 131µs
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
2621148µs230µsLocale::Recode::::resolveAliasLocale::Recode::resolveAlias
0000s0sLocale::Recode::::BEGIN@24Locale::Recode::BEGIN@24
0000s0sLocale::Recode::::getCharsetsLocale::Recode::getCharsets
0000s0sLocale::Recode::::getErrorLocale::Recode::getError
0000s0sLocale::Recode::::getSupportedLocale::Recode::getSupported
0000s0sLocale::Recode::::newLocale::Recode::new
0000s0sLocale::Recode::::recodeLocale::Recode::recode
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# Portable character conversion for Perl.
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::Recode;
23
24use strict;
25
26require Locale::Recode::_Conversions;
27
28my $loaded = {};
29my $has_encode;
30
31sub new
32{
33 my $class = ref($_[0]) || $_[0];
34 shift;
35 my %args = @_;
36
37 my $self = bless {}, $class;
38
39 my ($from_codeset, $to_codeset) = @args{qw (from to)};
40
41 unless ($from_codeset && $to_codeset) {
42 require Carp;
43 Carp::croak (<<EOF);
44 Usage: $class->new (from => FROM_CODESET, to => TO_CODESET);
45EOF
46 }
47
48 # Find a conversion path.
49 my $path = Locale::Recode::_Conversions->findPath ($from_codeset,
50 $to_codeset);
51 unless ($path) {
52 $self->{__error} = 'EINVAL';
53 return $self;
54 }
55
56 my @conversions = ();
57 foreach (@$path) {
58 my ($module, $from, $to) = @$_;
59
60 unless ($loaded->{$module}) {
61 eval "require Locale::RecodeData::$module";
62 if ($@) {
63 $self->{__error} = $@;
64 return $self;
65 }
66
67 $loaded->{$module} = 1;
68 }
69
70 my $module_name = "Locale::RecodeData::$module";
71 my $method = 'new';
72 my $object = $module_name->$method (from => $from,
73 to => $to);
74
75 push @conversions, $object;
76 }
77
78 $self->{__conversions} = \@conversions;
79
80 return $self;
81}
82
83sub resolveAlias
84
# spent 230µs (148+82) within Locale::Recode::resolveAlias which was called 26 times, avg 9µs/call: # 25 times (145µs+80µs) by Locale::gettext_pp::__load_catalog at line 743 of Locale/gettext_pp.pm, avg 9µs/call # once (4µs+2µs) by Locale::gettext_pp::_dcnpgettext_impl at line 424 of Locale/gettext_pp.pm
{
852619µs my ($class, $alias) = @_;
86
8726112µs2682µs return Locale::Recode::_Conversions->resolveAlias ($alias);
# spent 82µs making 26 calls to Locale::Recode::_Conversions::resolveAlias, avg 3µs/call
88}
89
90sub getSupported
91{
92 return [ Locale::Recode::_Conversions->listSupported ];
93}
94
95sub getCharsets
96{
97 my $self = shift;
98 my %all = map { $_ => 1 } @{&getSupported};
99
100 require Locale::Recode::_Aliases;
101
102 my $conversions = Locale::Recode::_Conversions->listSupported;
103 foreach my $charset (keys %{Locale::Recode::_Aliases::ALIASES()}) {
104 my $mime_name = $self->resolveAlias ($charset);
105 next unless exists $all{$mime_name};
106 $all{$charset} = 1;
107 }
108
109 return [ keys %all ];
110}
111
112sub recode
113{
114 my $self = $_[0];
115
116 return if $self->{__error};
117
118 return 1 unless defined $_[1];
119
120 my $chain = $self->{__conversions};
121
122 foreach my $module (@$chain) {
123 my $success = $module->_recode ($_[1]);
124
125 unless ($success) {
126 $self->{__error} = $module->_getError;
127 return;
128 }
129 }
130
131 return 1;
132}
133
134sub getError
135{
136 my $self = shift;
137 my $error = $self->{__error} or return;
138
139 if ('EINVAL' eq $error) {
140 return 'Invalid conversion';
141 } else {
142 return $error;
143 }
144}
145
1461;
147
148__END__