Filename | /usr/local/lib/perl5/site_perl/Locale/Recode.pm |
Statements | Executed 52 statements in 131µs |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
26 | 2 | 1 | 148µs | 230µs | resolveAlias | Locale::Recode::
0 | 0 | 0 | 0s | 0s | BEGIN@24 | Locale::Recode::
0 | 0 | 0 | 0s | 0s | getCharsets | Locale::Recode::
0 | 0 | 0 | 0s | 0s | getError | Locale::Recode::
0 | 0 | 0 | 0s | 0s | getSupported | Locale::Recode::
0 | 0 | 0 | 0s | 0s | new | Locale::Recode::
0 | 0 | 0 | 0s | 0s | recode | Locale::Recode::
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 | |||||
22 | package Locale::Recode; | ||||
23 | |||||
24 | use strict; | ||||
25 | |||||
26 | require Locale::Recode::_Conversions; | ||||
27 | |||||
28 | my $loaded = {}; | ||||
29 | my $has_encode; | ||||
30 | |||||
31 | sub 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); | ||||
45 | EOF | ||||
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 | |||||
83 | sub 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 | ||||
85 | 26 | 19µs | my ($class, $alias) = @_; | ||
86 | |||||
87 | 26 | 112µs | 26 | 82µs | return Locale::Recode::_Conversions->resolveAlias ($alias); # spent 82µs making 26 calls to Locale::Recode::_Conversions::resolveAlias, avg 3µs/call |
88 | } | ||||
89 | |||||
90 | sub getSupported | ||||
91 | { | ||||
92 | return [ Locale::Recode::_Conversions->listSupported ]; | ||||
93 | } | ||||
94 | |||||
95 | sub 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 | |||||
112 | sub 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 | |||||
134 | sub 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 | |||||
146 | 1; | ||||
147 | |||||
148 | __END__ |