Filename | /usr/lib64/perl5/vendor_perl/5.16.0/x86_64-linux/Encode.pm |
Statements | Executed 80 statements in 83.1ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 9.15ms | 14.4ms | BEGIN@48 | Encode::
1 | 1 | 1 | 3.16ms | 3.50ms | predefine_encodings | Encode::
4 | 1 | 1 | 106µs | 106µs | define_encoding | Encode::
1 | 1 | 1 | 77µs | 177µs | BEGIN@5 | Encode::
1 | 1 | 1 | 75µs | 155µs | BEGIN@241 | Encode::
1 | 1 | 1 | 71µs | 88µs | BEGIN@324 | Encode::utf8::
1 | 1 | 1 | 68µs | 68µs | BEGIN@9 | Encode::
1 | 1 | 1 | 57µs | 295µs | BEGIN@8 | Encode::
1 | 1 | 1 | 56µs | 88µs | BEGIN@6 | Encode::
1 | 1 | 1 | 55µs | 438µs | BEGIN@13 | Encode::
1 | 1 | 1 | 27µs | 27µs | CORE:match (opcode) | Encode::
0 | 0 | 0 | 0s | 0s | __ANON__[:284] | Encode::Internal::
0 | 0 | 0 | 0s | 0s | __ANON__[:259] | Encode::UTF_EBCDIC::
0 | 0 | 0 | 0s | 0s | __ANON__[:271] | Encode::UTF_EBCDIC::
0 | 0 | 0 | 0s | 0s | clone_encoding | Encode::
0 | 0 | 0 | 0s | 0s | decode | Encode::
0 | 0 | 0 | 0s | 0s | decode_utf8 | Encode::
0 | 0 | 0 | 0s | 0s | encode | Encode::
0 | 0 | 0 | 0s | 0s | encode_utf8 | Encode::
0 | 0 | 0 | 0s | 0s | encodings | Encode::
0 | 0 | 0 | 0s | 0s | find_encoding | Encode::
0 | 0 | 0 | 0s | 0s | from_to | Encode::
0 | 0 | 0 | 0s | 0s | getEncoding | Encode::
0 | 0 | 0 | 0s | 0s | perlio_ok | Encode::
0 | 0 | 0 | 0s | 0s | resolve_alias | Encode::
0 | 0 | 0 | 0s | 0s | __ANON__[:312] | Encode::utf8::
0 | 0 | 0 | 0s | 0s | __ANON__[:318] | Encode::utf8::
0 | 0 | 0 | 0s | 0s | __ANON__[:334] | Encode::utf8::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # $Id: Encode.pm,v 2.47 2012/08/15 05:36:16 dankogai Exp dankogai $ | ||||
3 | # | ||||
4 | package Encode; | ||||
5 | 2 | 168µs | 2 | 276µs | # spent 177µs (77+99) within Encode::BEGIN@5 which was called:
# once (77µs+99µs) by Pod::Text::BEGIN@32 at line 5 # spent 177µs making 1 call to Encode::BEGIN@5
# spent 99µs making 1 call to strict::import |
6 | 2 | 329µs | 2 | 120µs | # spent 88µs (56+32) within Encode::BEGIN@6 which was called:
# once (56µs+32µs) by Pod::Text::BEGIN@32 at line 6 # spent 88µs making 1 call to Encode::BEGIN@6
# spent 32µs making 1 call to warnings::import |
7 | 1 | 80µs | 1 | 27µs | our $VERSION = sprintf "%d.%02d", q$Revision: 2.47 $ =~ /(\d+)/g; # spent 27µs making 1 call to Encode::CORE:match |
8 | 2 | 209µs | 2 | 533µs | # spent 295µs (57+238) within Encode::BEGIN@8 which was called:
# once (57µs+238µs) by Pod::Text::BEGIN@32 at line 8 # spent 295µs making 1 call to Encode::BEGIN@8
# spent 238µs making 1 call to constant::import |
9 | 2 | 240µs | 1 | 68µs | # spent 68µs within Encode::BEGIN@9 which was called:
# once (68µs+0s) by Pod::Text::BEGIN@32 at line 9 # spent 68µs making 1 call to Encode::BEGIN@9 |
10 | 1 | 68.4ms | 1 | 68.6ms | XSLoader::load( __PACKAGE__, $VERSION ); # spent 68.6ms making 1 call to XSLoader::load |
11 | |||||
12 | 1 | 4µs | require Exporter; | ||
13 | 2 | 832µs | 2 | 822µs | # spent 438µs (55+383) within Encode::BEGIN@13 which was called:
# once (55µs+383µs) by Pod::Text::BEGIN@32 at line 13 # spent 438µs making 1 call to Encode::BEGIN@13
# spent 383µs making 1 call to base::import |
14 | |||||
15 | # Public, encouraged API is exported by default | ||||
16 | |||||
17 | 1 | 13µs | our @EXPORT = qw( | ||
18 | decode decode_utf8 encode encode_utf8 str2bytes bytes2str | ||||
19 | encodings find_encoding clone_encoding | ||||
20 | ); | ||||
21 | 1 | 9µs | our @FB_FLAGS = qw( | ||
22 | DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC | ||||
23 | PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL | ||||
24 | ); | ||||
25 | 1 | 8µs | our @FB_CONSTS = qw( | ||
26 | FB_DEFAULT FB_CROAK FB_QUIET FB_WARN | ||||
27 | FB_PERLQQ FB_HTMLCREF FB_XMLCREF | ||||
28 | ); | ||||
29 | 1 | 20µs | our @EXPORT_OK = ( | ||
30 | qw( | ||||
31 | _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit | ||||
32 | is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade | ||||
33 | ), | ||||
34 | @FB_FLAGS, @FB_CONSTS, | ||||
35 | ); | ||||
36 | |||||
37 | 1 | 64µs | our %EXPORT_TAGS = ( | ||
38 | all => [ @EXPORT, @EXPORT_OK ], | ||||
39 | default => [ @EXPORT ], | ||||
40 | fallbacks => [ @FB_CONSTS ], | ||||
41 | fallback_all => [ @FB_CONSTS, @FB_FLAGS ], | ||||
42 | ); | ||||
43 | |||||
44 | # Documentation moved after __END__ for speed - NI-S | ||||
45 | |||||
46 | 1 | 3µs | our $ON_EBCDIC = ( ord("A") == 193 ); | ||
47 | |||||
48 | 2 | 6.86ms | 2 | 14.6ms | # spent 14.4ms (9.15+5.21) within Encode::BEGIN@48 which was called:
# once (9.15ms+5.21ms) by Pod::Text::BEGIN@32 at line 48 # spent 14.4ms making 1 call to Encode::BEGIN@48
# spent 215µs making 1 call to Exporter::import |
49 | |||||
50 | # Make a %Encoding package variable to allow a certain amount of cheating | ||||
51 | 1 | 900ns | our %Encoding; | ||
52 | 1 | 1µs | our %ExtModule; | ||
53 | 1 | 732µs | require Encode::Config; | ||
54 | # See | ||||
55 | # https://bugzilla.redhat.com/show_bug.cgi?id=435505#c2 | ||||
56 | # to find why sig handers inside eval{} are disabled. | ||||
57 | 1 | 3µs | eval { | ||
58 | 1 | 16µs | local $SIG{__DIE__}; | ||
59 | 1 | 9µs | local $SIG{__WARN__}; | ||
60 | 1 | 297µs | require Encode::ConfigLocal; | ||
61 | }; | ||||
62 | |||||
63 | sub encodings { | ||||
64 | my %enc; | ||||
65 | if ( @_ and $_[1] eq ":all" ) { | ||||
66 | %enc = ( %Encoding, %ExtModule ); | ||||
67 | } | ||||
68 | else { | ||||
69 | %enc = %Encoding; | ||||
70 | for my $mod ( map { m/::/ ? $_ : "Encode::$_" } @_ ) { | ||||
71 | DEBUG and warn $mod; | ||||
72 | for my $enc ( keys %ExtModule ) { | ||||
73 | $ExtModule{$enc} eq $mod and $enc{$enc} = $mod; | ||||
74 | } | ||||
75 | } | ||||
76 | } | ||||
77 | return sort { lc $a cmp lc $b } | ||||
78 | grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc; | ||||
79 | } | ||||
80 | |||||
81 | sub perlio_ok { | ||||
82 | my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] ); | ||||
83 | $obj->can("perlio_ok") and return $obj->perlio_ok(); | ||||
84 | return 0; # safety net | ||||
85 | } | ||||
86 | |||||
87 | # spent 106µs within Encode::define_encoding which was called 4 times, avg 27µs/call:
# 4 times (106µs+0s) by XSLoader::load at line 92 of XSLoader.pm, avg 27µs/call | ||||
88 | 4 | 9µs | my $obj = shift; | ||
89 | 4 | 6µs | my $name = shift; | ||
90 | 4 | 19µs | $Encoding{$name} = $obj; | ||
91 | 4 | 9µs | my $lc = lc($name); | ||
92 | 4 | 7µs | define_alias( $lc => $obj ) unless $lc eq $name; | ||
93 | 4 | 15µs | while (@_) { | ||
94 | my $alias = shift; | ||||
95 | define_alias( $alias, $obj ); | ||||
96 | } | ||||
97 | 4 | 78µs | return $obj; | ||
98 | } | ||||
99 | |||||
100 | sub getEncoding { | ||||
101 | my ( $class, $name, $skip_external ) = @_; | ||||
102 | |||||
103 | $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796 | ||||
104 | |||||
105 | ref($name) && $name->can('renew') and return $name; | ||||
106 | exists $Encoding{$name} and return $Encoding{$name}; | ||||
107 | my $lc = lc $name; | ||||
108 | exists $Encoding{$lc} and return $Encoding{$lc}; | ||||
109 | |||||
110 | my $oc = $class->find_alias($name); | ||||
111 | defined($oc) and return $oc; | ||||
112 | $lc ne $name and $oc = $class->find_alias($lc); | ||||
113 | defined($oc) and return $oc; | ||||
114 | |||||
115 | unless ($skip_external) { | ||||
116 | if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) { | ||||
117 | $mod =~ s,::,/,g; | ||||
118 | $mod .= '.pm'; | ||||
119 | eval { require $mod; }; | ||||
120 | exists $Encoding{$name} and return $Encoding{$name}; | ||||
121 | } | ||||
122 | } | ||||
123 | return; | ||||
124 | } | ||||
125 | |||||
126 | sub find_encoding($;$) { | ||||
127 | my ( $name, $skip_external ) = @_; | ||||
128 | return __PACKAGE__->getEncoding( $name, $skip_external ); | ||||
129 | } | ||||
130 | |||||
131 | sub resolve_alias($) { | ||||
132 | my $obj = find_encoding(shift); | ||||
133 | defined $obj and return $obj->name; | ||||
134 | return; | ||||
135 | } | ||||
136 | |||||
137 | sub clone_encoding($) { | ||||
138 | my $obj = find_encoding(shift); | ||||
139 | ref $obj or return; | ||||
140 | eval { require Storable }; | ||||
141 | $@ and return; | ||||
142 | return Storable::dclone($obj); | ||||
143 | } | ||||
144 | |||||
145 | sub encode($$;$) { | ||||
146 | my ( $name, $string, $check ) = @_; | ||||
147 | return undef unless defined $string; | ||||
148 | $string .= '' if ref $string; # stringify; | ||||
149 | $check ||= 0; | ||||
150 | unless ( defined $name ) { | ||||
151 | require Carp; | ||||
152 | Carp::croak("Encoding name should not be undef"); | ||||
153 | } | ||||
154 | my $enc = find_encoding($name); | ||||
155 | unless ( defined $enc ) { | ||||
156 | require Carp; | ||||
157 | Carp::croak("Unknown encoding '$name'"); | ||||
158 | } | ||||
159 | my $octets = $enc->encode( $string, $check ); | ||||
160 | $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() ); | ||||
161 | return $octets; | ||||
162 | } | ||||
163 | 1 | 12µs | *str2bytes = \&encode; | ||
164 | |||||
165 | sub decode($$;$) { | ||||
166 | my ( $name, $octets, $check ) = @_; | ||||
167 | return undef unless defined $octets; | ||||
168 | $octets .= '' if ref $octets; | ||||
169 | $check ||= 0; | ||||
170 | my $enc = find_encoding($name); | ||||
171 | unless ( defined $enc ) { | ||||
172 | require Carp; | ||||
173 | Carp::croak("Unknown encoding '$name'"); | ||||
174 | } | ||||
175 | my $string = $enc->decode( $octets, $check ); | ||||
176 | $_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() ); | ||||
177 | return $string; | ||||
178 | } | ||||
179 | 1 | 4µs | *bytes2str = \&decode; | ||
180 | |||||
181 | sub from_to($$$;$) { | ||||
182 | my ( $string, $from, $to, $check ) = @_; | ||||
183 | return undef unless defined $string; | ||||
184 | $check ||= 0; | ||||
185 | my $f = find_encoding($from); | ||||
186 | unless ( defined $f ) { | ||||
187 | require Carp; | ||||
188 | Carp::croak("Unknown encoding '$from'"); | ||||
189 | } | ||||
190 | my $t = find_encoding($to); | ||||
191 | unless ( defined $t ) { | ||||
192 | require Carp; | ||||
193 | Carp::croak("Unknown encoding '$to'"); | ||||
194 | } | ||||
195 | my $uni = $f->decode($string); | ||||
196 | $_[0] = $string = $t->encode( $uni, $check ); | ||||
197 | return undef if ( $check && length($uni) ); | ||||
198 | return defined( $_[0] ) ? length($string) : undef; | ||||
199 | } | ||||
200 | |||||
201 | sub encode_utf8($) { | ||||
202 | my ($str) = @_; | ||||
203 | utf8::encode($str); | ||||
204 | return $str; | ||||
205 | } | ||||
206 | |||||
207 | 1 | 2µs | my $utf8enc; | ||
208 | |||||
209 | sub decode_utf8($;$) { | ||||
210 | my ( $octets, $check ) = @_; | ||||
211 | return $octets if is_utf8($octets); | ||||
212 | return undef unless defined $octets; | ||||
213 | $octets .= '' if ref $octets; | ||||
214 | $check ||= 0; | ||||
215 | $utf8enc ||= find_encoding('utf8'); | ||||
216 | my $string = $utf8enc->decode( $octets, $check ); | ||||
217 | $_[0] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() ); | ||||
218 | return $string; | ||||
219 | } | ||||
220 | |||||
221 | # sub decode_utf8($;$) { | ||||
222 | # my ( $str, $check ) = @_; | ||||
223 | # return $str if is_utf8($str); | ||||
224 | # if ($check) { | ||||
225 | # return decode( "utf8", $str, $check ); | ||||
226 | # } | ||||
227 | # else { | ||||
228 | # return decode( "utf8", $str ); | ||||
229 | # return $str; | ||||
230 | # } | ||||
231 | # } | ||||
232 | |||||
233 | 1 | 17µs | 1 | 3.50ms | predefine_encodings(1); # spent 3.50ms making 1 call to Encode::predefine_encodings |
234 | |||||
235 | # | ||||
236 | # This is to restore %Encoding if really needed; | ||||
237 | # | ||||
238 | |||||
239 | # spent 3.50ms (3.16+339µs) within Encode::predefine_encodings which was called:
# once (3.16ms+339µs) by Pod::Text::BEGIN@32 at line 233 | ||||
240 | 1 | 461µs | require Encode::Encoding; | ||
241 | 2 | 3.01ms | 2 | 236µs | # spent 155µs (75+80) within Encode::BEGIN@241 which was called:
# once (75µs+80µs) by Pod::Text::BEGIN@32 at line 241 # spent 155µs making 1 call to Encode::BEGIN@241
# spent 80µs making 1 call to warnings::unimport |
242 | 1 | 4µs | my $use_xs = shift; | ||
243 | 1 | 4µs | if ($ON_EBCDIC) { | ||
244 | |||||
245 | # was in Encode::UTF_EBCDIC | ||||
246 | package Encode::UTF_EBCDIC; | ||||
247 | push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding'; | ||||
248 | *decode = sub { | ||||
249 | my ( undef, $str, $chk ) = @_; | ||||
250 | my $res = ''; | ||||
251 | for ( my $i = 0 ; $i < length($str) ; $i++ ) { | ||||
252 | $res .= | ||||
253 | chr( | ||||
254 | utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) ) | ||||
255 | ); | ||||
256 | } | ||||
257 | $_[1] = '' if $chk; | ||||
258 | return $res; | ||||
259 | }; | ||||
260 | *encode = sub { | ||||
261 | my ( undef, $str, $chk ) = @_; | ||||
262 | my $res = ''; | ||||
263 | for ( my $i = 0 ; $i < length($str) ; $i++ ) { | ||||
264 | $res .= | ||||
265 | chr( | ||||
266 | utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) ) | ||||
267 | ); | ||||
268 | } | ||||
269 | $_[1] = '' if $chk; | ||||
270 | return $res; | ||||
271 | }; | ||||
272 | $Encode::Encoding{Unicode} = | ||||
273 | bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC"; | ||||
274 | } | ||||
275 | else { | ||||
276 | |||||
277 | package Encode::Internal; | ||||
278 | 1 | 48µs | push @Encode::Internal::ISA, 'Encode::Encoding'; | ||
279 | *decode = sub { | ||||
280 | my ( undef, $str, $chk ) = @_; | ||||
281 | utf8::upgrade($str); | ||||
282 | $_[1] = '' if $chk; | ||||
283 | return $str; | ||||
284 | 1 | 16µs | }; | ||
285 | 1 | 3µs | *encode = \&decode; | ||
286 | 1 | 37µs | $Encode::Encoding{Unicode} = | ||
287 | bless { Name => "Internal" } => "Encode::Internal"; | ||||
288 | } | ||||
289 | |||||
290 | { | ||||
291 | |||||
292 | # was in Encode::utf8 | ||||
293 | 1 | 27µs | package Encode::utf8; | ||
294 | 1 | 18µs | push @Encode::utf8::ISA, 'Encode::Encoding'; | ||
295 | |||||
296 | # | ||||
297 | 1 | 4µs | if ($use_xs) { | ||
298 | Encode::DEBUG and warn __PACKAGE__, " XS on"; | ||||
299 | 1 | 5µs | *decode = \&decode_xs; | ||
300 | 1 | 4µs | *encode = \&encode_xs; | ||
301 | } | ||||
302 | else { | ||||
303 | Encode::DEBUG and warn __PACKAGE__, " XS off"; | ||||
304 | *decode = sub { | ||||
305 | my ( undef, $octets, $chk ) = @_; | ||||
306 | my $str = Encode::decode_utf8($octets); | ||||
307 | if ( defined $str ) { | ||||
308 | $_[1] = '' if $chk; | ||||
309 | return $str; | ||||
310 | } | ||||
311 | return undef; | ||||
312 | }; | ||||
313 | *encode = sub { | ||||
314 | my ( undef, $string, $chk ) = @_; | ||||
315 | my $octets = Encode::encode_utf8($string); | ||||
316 | $_[1] = '' if $chk; | ||||
317 | return $octets; | ||||
318 | }; | ||||
319 | } | ||||
320 | *cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk) | ||||
321 | # currently ignores $chk | ||||
322 | my ( undef, undef, undef, $pos, $trm ) = @_; | ||||
323 | my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ]; | ||||
324 | 2 | 789µs | 2 | 105µs | # spent 88µs (71+17) within Encode::utf8::BEGIN@324 which was called:
# once (71µs+17µs) by Pod::Text::BEGIN@32 at line 324 # spent 88µs making 1 call to Encode::utf8::BEGIN@324
# spent 17µs making 1 call to bytes::import |
325 | if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) { | ||||
326 | $$rdst .= | ||||
327 | substr( $$rsrc, $pos, $npos - $pos + length($trm) ); | ||||
328 | $$rpos = $npos + length($trm); | ||||
329 | return 1; | ||||
330 | } | ||||
331 | $$rdst .= substr( $$rsrc, $pos ); | ||||
332 | $$rpos = length($$rsrc); | ||||
333 | return ''; | ||||
334 | 1 | 20µs | }; | ||
335 | 1 | 25µs | $Encode::Encoding{utf8} = | ||
336 | bless { Name => "utf8" } => "Encode::utf8"; | ||||
337 | 1 | 14µs | $Encode::Encoding{"utf-8-strict"} = | ||
338 | bless { Name => "utf-8-strict", strict_utf8 => 1 } | ||||
339 | => "Encode::utf8"; | ||||
340 | } | ||||
341 | } | ||||
342 | |||||
343 | 1 | 84µs | 1; | ||
344 | |||||
345 | __END__ | ||||
# spent 27µs within Encode::CORE:match which was called:
# once (27µs+0s) by Pod::Text::BEGIN@32 at line 7 |