← Index
NYTProf Performance Profile   « line view »
For /usr/local/bin/sa-learn
  Run on Tue Nov 7 05:38:10 2017
Reported on Tue Nov 7 06:16:00 2017

Filename/usr/local/lib/perl5/5.24/mach/Encode.pm
StatementsExecuted 142 statements in 7.55ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
10391110.2ms10.2msEncode::utf8::::encode_xs Encode::utf8::encode_xs (xsub)
1114.10ms8.31msEncode::::BEGIN@47 Encode::BEGIN@47
1111.34ms1.47msEncode::::predefine_encodings Encode::predefine_encodings
711204µs1.75msEncode::::getEncoding Encode::getEncoding (recurses: max depth 1, inclusive time 61µs)
511160µs160µsEncode::::define_encoding Encode::define_encoding
763131µs1.84msEncode::::find_encoding Encode::find_encoding (recurses: max depth 1, inclusive time 105µs)
11156µs63µsEncode::::BEGIN@5 Encode::BEGIN@5
11148µs108µsEncode::::BEGIN@12 Encode::BEGIN@12
11135µs48µsEncode::utf8::::BEGIN@355 Encode::utf8::BEGIN@355
11133µs94µsEncode::::BEGIN@268 Encode::BEGIN@268
11132µs35µsEncode::::encode_utf8 Encode::encode_utf8
71131µs31µsEncode::::CORE:subst Encode::CORE:subst (opcode)
11126µs234µsEncode::::BEGIN@8 Encode::BEGIN@8
11118µs53µsEncode::::BEGIN@6 Encode::BEGIN@6
11113µs13µsEncode::::CORE:match Encode::CORE:match (opcode)
11110µs10µsEncode::::BEGIN@9 Encode::BEGIN@9
0000s0sEncode::Internal::::__ANON__[:311] Encode::Internal::__ANON__[:311]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:286]Encode::UTF_EBCDIC::__ANON__[:286]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:298]Encode::UTF_EBCDIC::__ANON__[:298]
0000s0sEncode::::__ANON__[:167] Encode::__ANON__[:167]
0000s0sEncode::::__ANON__[:196] Encode::__ANON__[:196]
0000s0sEncode::::clone_encoding Encode::clone_encoding
0000s0sEncode::::decode Encode::decode
0000s0sEncode::::decode_utf8 Encode::decode_utf8
0000s0sEncode::::encode Encode::encode
0000s0sEncode::::encodings Encode::encodings
0000s0sEncode::::from_to Encode::from_to
0000s0sEncode::::perlio_ok Encode::perlio_ok
0000s0sEncode::::resolve_alias Encode::resolve_alias
0000s0sEncode::utf8::::__ANON__[:343] Encode::utf8::__ANON__[:343]
0000s0sEncode::utf8::::__ANON__[:349] Encode::utf8::__ANON__[:349]
0000s0sEncode::utf8::::__ANON__[:365] Encode::utf8::__ANON__[:365]
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1#
2# $Id: Encode.pm,v 2.80 2016/01/25 14:54:01 dankogai Exp $
3#
4package Encode;
5265µs271µs
# spent 63µs (56+7) within Encode::BEGIN@5 which was called: # once (56µs+7µs) by Pod::Text::BEGIN@33 at line 5
use strict;
# spent 63µs making 1 call to Encode::BEGIN@5 # spent 8µs making 1 call to strict::import
62159µs288µs
# spent 53µs (18+35) within Encode::BEGIN@6 which was called: # once (18µs+35µs) by Pod::Text::BEGIN@33 at line 6
use warnings;
# spent 53µs making 1 call to Encode::BEGIN@6 # spent 35µs making 1 call to warnings::import
7136µs113µsour $VERSION = sprintf "%d.%02d_01", q$Revision: 2.80 $ =~ /(\d+)/g;
# spent 13µs making 1 call to Encode::CORE:match
8258µs2442µs
# spent 234µs (26+208) within Encode::BEGIN@8 which was called: # once (26µs+208µs) by Pod::Text::BEGIN@33 at line 8
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
# spent 234µs making 1 call to Encode::BEGIN@8 # spent 208µs making 1 call to constant::import
92111µs110µs
# spent 10µs within Encode::BEGIN@9 which was called: # once (10µs+0s) by Pod::Text::BEGIN@33 at line 9
use XSLoader ();
# spent 10µs making 1 call to Encode::BEGIN@9
101456µs1670µsXSLoader::load( __PACKAGE__, $VERSION );
# spent 670µs making 1 call to XSLoader::load
11
123359µs3168µs
# spent 108µs (48+60) within Encode::BEGIN@12 which was called: # once (48µs+60µs) by Pod::Text::BEGIN@33 at line 12
use Exporter 5.57 'import';
# spent 108µs making 1 call to Encode::BEGIN@12 # spent 40µs making 1 call to Exporter::import # spent 21µs making 1 call to UNIVERSAL::VERSION
13
14# Public, encouraged API is exported by default
15
1618µsour @EXPORT = qw(
17 decode decode_utf8 encode encode_utf8 str2bytes bytes2str
18 encodings find_encoding clone_encoding
19);
2018µsour @FB_FLAGS = qw(
21 DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
22 PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
23);
2414µsour @FB_CONSTS = qw(
25 FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
26 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
27);
2818µsour @EXPORT_OK = (
29 qw(
30 _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
31 is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
32 ),
33 @FB_FLAGS, @FB_CONSTS,
34);
35
36116µsour %EXPORT_TAGS = (
37 all => [ @EXPORT, @EXPORT_OK ],
38 default => [ @EXPORT ],
39 fallbacks => [ @FB_CONSTS ],
40 fallback_all => [ @FB_CONSTS, @FB_FLAGS ],
41);
42
43# Documentation moved after __END__ for speed - NI-S
44
4512µsour $ON_EBCDIC = ( ord("A") == 193 );
46
4723.15ms28.50ms
# spent 8.31ms (4.10+4.22) within Encode::BEGIN@47 which was called: # once (4.10ms+4.22ms) by Pod::Text::BEGIN@33 at line 47
use Encode::Alias;
# spent 8.31ms making 1 call to Encode::BEGIN@47 # spent 181µs making 1 call to Exporter::import
48
49# Make a %Encoding package variable to allow a certain amount of cheating
50our %Encoding;
51our %ExtModule;
521364µsrequire Encode::Config;
53# See
54# https://bugzilla.redhat.com/show_bug.cgi?id=435505#c2
55# to find why sig handlers inside eval{} are disabled.
5612µseval {
5715µs local $SIG{__DIE__};
5813µs local $SIG{__WARN__};
59116µs local @INC = @INC;
6012µs pop @INC if $INC[-1] eq '.';
611169µs require Encode::ConfigLocal;
62};
63
64sub encodings {
65 my %enc;
66 my $arg = $_[1] || '';
67 if ( $arg eq ":all" ) {
68 %enc = ( %Encoding, %ExtModule );
69 }
70 else {
71 %enc = %Encoding;
72 for my $mod ( map { m/::/ ? $_ : "Encode::$_" } @_ ) {
73 DEBUG and warn $mod;
74 for my $enc ( keys %ExtModule ) {
75 $ExtModule{$enc} eq $mod and $enc{$enc} = $mod;
76 }
77 }
78 }
79 return sort { lc $a cmp lc $b }
80 grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc;
81}
82
83sub perlio_ok {
84 my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] );
85 $obj->can("perlio_ok") and return $obj->perlio_ok();
86 return 0; # safety net
87}
88
89
# spent 160µs within Encode::define_encoding which was called 5 times, avg 32µs/call: # 5 times (160µs+0s) by XSLoader::load at line 114 of XSLoader.pm, avg 32µs/call
sub define_encoding {
9059µs my $obj = shift;
91523µs my $name = shift;
92520µs $Encoding{$name} = $obj;
93512µs my $lc = lc($name);
9458µs define_alias( $lc => $obj ) unless $lc eq $name;
95526µs while (@_) {
96 my $alias = shift;
97 define_alias( $alias, $obj );
98 }
99570µs return $obj;
100}
101
102
# spent 1.75ms (204µs+1.55) within Encode::getEncoding which was called 7 times, avg 250µs/call: # 7 times (204µs+1.55ms) by Encode::find_encoding at line 130, avg 250µs/call
sub getEncoding {
103716µs my ( $class, $name, $skip_external ) = @_;
104
105797µs731µs $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
# spent 31µs making 7 calls to Encode::CORE:subst, avg 4µs/call
106
107712µs ref($name) && $name->can('renew') and return $name;
108764µs exists $Encoding{$name} and return $Encoding{$name};
10927µs my $lc = lc $name;
11024µs exists $Encoding{$lc} and return $Encoding{$lc};
111
112215µs21.58ms my $oc = $class->find_alias($name);
# spent 1.58ms making 2 calls to Encode::Alias::find_alias, avg 789µs/call
113212µs defined($oc) and return $oc;
114 $lc ne $name and $oc = $class->find_alias($lc);
115 defined($oc) and return $oc;
116
117 unless ($skip_external) {
118 if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) {
119 $mod =~ s,::,/,g;
120 $mod .= '.pm';
121 eval { require $mod; };
122 exists $Encoding{$name} and return $Encoding{$name};
123 }
124 }
125 return;
126}
127
128
# spent 1.84ms (131µs+1.71) within Encode::find_encoding which was called 7 times, avg 263µs/call: # 2 times (44µs+-44µs) by Encode::Alias::find_alias at line 46 of Encode/Alias.pm, avg 0s/call # once (20µs+1.36ms) by Mail::SpamAssassin::Message::Node::BEGIN@49 at line 52 of Mail/SpamAssassin/Message/Node.pm # once (17µs+308µs) by Mail::SpamAssassin::Message::Node::BEGIN@49 at line 51 of Mail/SpamAssassin/Message/Node.pm # once (20µs+28µs) by Net::DNS::RR::BEGIN@42 at line 59 of Net/DNS/Domain.pm # once (17µs+26µs) by Net::DNS::Domain::BEGIN@44 at line 46 of Net/DNS/Domain.pm # once (12µs+30µs) by Net::DNS::RR::BEGIN@42 at line 60 of Net/DNS/Domain.pm
sub find_encoding($;$) {
129726µs my ( $name, $skip_external ) = @_;
1307128µs71.75ms return __PACKAGE__->getEncoding( $name, $skip_external );
# spent 1.81ms making 7 calls to Encode::getEncoding, avg 259µs/call, recursion: max depth 1, sum of overlapping time 61µs
131}
132
133sub resolve_alias($) {
134 my $obj = find_encoding(shift);
135 defined $obj and return $obj->name;
136 return;
137}
138
139sub clone_encoding($) {
140 my $obj = find_encoding(shift);
141 ref $obj or return;
142 eval { require Storable };
143 $@ and return;
144 return Storable::dclone($obj);
145}
146
147sub encode($$;$) {
148 my ( $name, $string, $check ) = @_;
149 return undef unless defined $string;
150 $string .= ''; # stringify;
151 $check ||= 0;
152 unless ( defined $name ) {
153 require Carp;
154 Carp::croak("Encoding name should not be undef");
155 }
156 my $enc = find_encoding($name);
157 unless ( defined $enc ) {
158 require Carp;
159 Carp::croak("Unknown encoding '$name'");
160 }
161 # For Unicode, warnings need to be caught and re-issued at this level
162 # so that callers can disable utf8 warnings lexically.
163 my $octets;
164 if ( ref($enc) eq 'Encode::Unicode' ) {
165 my $warn = '';
166 {
167 local $SIG{__WARN__} = sub { $warn = shift };
168 $octets = $enc->encode( $string, $check );
169 }
170 warnings::warnif('utf8', $warn) if length $warn;
171 }
172 else {
173 $octets = $enc->encode( $string, $check );
174 }
175 $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() );
176 return $octets;
177}
17814µs*str2bytes = \&encode;
179
180sub decode($$;$) {
181 my ( $name, $octets, $check ) = @_;
182 return undef unless defined $octets;
183 $octets .= '';
184 $check ||= 0;
185 my $enc = find_encoding($name);
186 unless ( defined $enc ) {
187 require Carp;
188 Carp::croak("Unknown encoding '$name'");
189 }
190 # For Unicode, warnings need to be caught and re-issued at this level
191 # so that callers can disable utf8 warnings lexically.
192 my $string;
193 if ( ref($enc) eq 'Encode::Unicode' ) {
194 my $warn = '';
195 {
196 local $SIG{__WARN__} = sub { $warn = shift };
197 $string = $enc->decode( $octets, $check );
198 }
199 warnings::warnif('utf8', $warn) if length $warn;
200 }
201 else {
202 $string = $enc->decode( $octets, $check );
203 }
204 $_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() );
205 return $string;
206}
20712µs*bytes2str = \&decode;
208
209sub from_to($$$;$) {
210 my ( $string, $from, $to, $check ) = @_;
211 return undef unless defined $string;
212 $check ||= 0;
213 my $f = find_encoding($from);
214 unless ( defined $f ) {
215 require Carp;
216 Carp::croak("Unknown encoding '$from'");
217 }
218 my $t = find_encoding($to);
219 unless ( defined $t ) {
220 require Carp;
221 Carp::croak("Unknown encoding '$to'");
222 }
223 my $uni = $f->decode($string);
224 $_[0] = $string = $t->encode( $uni, $check );
225 return undef if ( $check && length($uni) );
226 return defined( $_[0] ) ? length($string) : undef;
227}
228
229
# spent 35µs (32+3) within Encode::encode_utf8 which was called: # once (32µs+3µs) by Net::DNS::Domain::BEGIN@49 at line 50 of Net/DNS/Domain.pm
sub encode_utf8($) {
23013µs my ($str) = @_;
231113µs13µs utf8::encode($str);
# spent 3µs making 1 call to utf8::encode
232110µs return $str;
233}
234
23515µsmy $utf8enc;
236
237sub decode_utf8($;$) {
238 my ( $octets, $check ) = @_;
239 return undef unless defined $octets;
240 $octets .= '';
241 $check ||= 0;
242 $utf8enc ||= find_encoding('utf8');
243 my $string = $utf8enc->decode( $octets, $check );
244 $_[0] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() );
245 return $string;
246}
247
248# sub decode_utf8($;$) {
249# my ( $str, $check ) = @_;
250# return $str if is_utf8($str);
251# if ($check) {
252# return decode( "utf8", $str, $check );
253# }
254# else {
255# return decode( "utf8", $str );
256# return $str;
257# }
258# }
259
260116µs11.47mspredefine_encodings(1);
# spent 1.47ms making 1 call to Encode::predefine_encodings
261
262#
263# This is to restore %Encoding if really needed;
264#
265
266
# spent 1.47ms (1.34+124µs) within Encode::predefine_encodings which was called: # once (1.34ms+124µs) by Pod::Text::BEGIN@33 at line 260
sub predefine_encodings {
2671264µs require Encode::Encoding;
26821.13ms2155µs
# spent 94µs (33+61) within Encode::BEGIN@268 which was called: # once (33µs+61µs) by Pod::Text::BEGIN@33 at line 268
no warnings 'redefine';
# spent 94µs making 1 call to Encode::BEGIN@268 # spent 61µs making 1 call to warnings::unimport
26912µs my $use_xs = shift;
27014µs if ($ON_EBCDIC) {
271
272 # was in Encode::UTF_EBCDIC
273 package Encode::UTF_EBCDIC;
274 push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding';
275 *decode = sub {
276 my ( undef, $str, $chk ) = @_;
277 my $res = '';
278 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
279 $res .=
280 chr(
281 utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) )
282 );
283 }
284 $_[1] = '' if $chk;
285 return $res;
286 };
287 *encode = sub {
288 my ( undef, $str, $chk ) = @_;
289 my $res = '';
290 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
291 $res .=
292 chr(
293 utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) )
294 );
295 }
296 $_[1] = '' if $chk;
297 return $res;
298 };
299 $Encode::Encoding{Unicode} =
300 bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC";
301 }
302 else {
303
304 package Encode::Internal;
305113µs push @Encode::Internal::ISA, 'Encode::Encoding';
306 *decode = sub {
307 my ( undef, $str, $chk ) = @_;
308 utf8::upgrade($str);
309 $_[1] = '' if $chk;
310 return $str;
31118µs };
31212µs *encode = \&decode;
313 $Encode::Encoding{Unicode} =
31419µs bless { Name => "Internal" } => "Encode::Internal";
315 }
316 {
317 # https://rt.cpan.org/Public/Bug/Display.html?id=103253
318 package Encode::XS;
319120µs push @Encode::XS::ISA, 'Encode::Encoding';
320 }
321 {
322
323 # was in Encode::utf8
324218µs package Encode::utf8;
325115µs push @Encode::utf8::ISA, 'Encode::Encoding';
326
327 #
32813µs if ($use_xs) {
329 Encode::DEBUG and warn __PACKAGE__, " XS on";
33012µs *decode = \&decode_xs;
33112µs *encode = \&encode_xs;
332 }
333 else {
334 Encode::DEBUG and warn __PACKAGE__, " XS off";
335 *decode = sub {
336 my ( undef, $octets, $chk ) = @_;
337 my $str = Encode::decode_utf8($octets);
338 if ( defined $str ) {
339 $_[1] = '' if $chk;
340 return $str;
341 }
342 return undef;
343 };
344 *encode = sub {
345 my ( undef, $string, $chk ) = @_;
346 my $octets = Encode::encode_utf8($string);
347 $_[1] = '' if $chk;
348 return $octets;
349 };
350 }
351 *cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk)
352 # currently ignores $chk
353 my ( undef, undef, undef, $pos, $trm ) = @_;
354 my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
3552392µs261µs
# spent 48µs (35+13) within Encode::utf8::BEGIN@355 which was called: # once (35µs+13µs) by Pod::Text::BEGIN@33 at line 355
use bytes;
# spent 48µs making 1 call to Encode::utf8::BEGIN@355 # spent 13µs making 1 call to bytes::import
356 if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
357 $$rdst .=
358 substr( $$rsrc, $pos, $npos - $pos + length($trm) );
359 $$rpos = $npos + length($trm);
360 return 1;
361 }
362 $$rdst .= substr( $$rsrc, $pos );
363 $$rpos = length($$rsrc);
364 return '';
36519µs };
366 $Encode::Encoding{utf8} =
36714µs bless { Name => "utf8" } => "Encode::utf8";
36817µs $Encode::Encoding{"utf-8-strict"} =
369 bless { Name => "utf-8-strict", strict_utf8 => 1 }
370 => "Encode::utf8";
371 }
372}
373
374144µs1;
375
376__END__
 
# spent 13µs within Encode::CORE:match which was called: # once (13µs+0s) by Pod::Text::BEGIN@33 at line 7
sub Encode::CORE:match; # opcode
# spent 31µs within Encode::CORE:subst which was called 7 times, avg 4µs/call: # 7 times (31µs+0s) by Encode::getEncoding at line 105, avg 4µs/call
sub Encode::CORE:subst; # opcode
# spent 10.2ms within Encode::utf8::encode_xs which was called 1039 times, avg 10µs/call: # 1039 times (10.2ms+0s) by Net::DNS::Domain::_encode_utf8 at line 312 of Net/DNS/Domain.pm, avg 10µs/call
sub Encode::utf8::encode_xs; # xsub
Report produced by the NYTProf 6.04 Perl profiler, developed by Tim Bunce based on work by Adam Kaplan and Salvador Fandiño García.