← Index
NYTProf Performance Profile   « line view »
For Makefile.PL
  Run on Sun Mar 1 16:04:44 2015
Reported on Sun Mar 1 16:09:02 2015

FilenameC:/tmp64ng/perl/lib/Encode.pm
StatementsExecuted 627 statements in 15.6ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
11115.6ms15.6msEncode::utf8::::BEGIN@349 Encode::utf8::BEGIN@349
1110s0sEncode::::BEGIN@12 Encode::BEGIN@12
1110s0sEncode::::BEGIN@266 Encode::BEGIN@266
1110s0sEncode::::BEGIN@47 Encode::BEGIN@47
1110s0sEncode::::BEGIN@5 Encode::BEGIN@5
1110s0sEncode::::BEGIN@6 Encode::BEGIN@6
1110s0sEncode::::BEGIN@8 Encode::BEGIN@8
1110s0sEncode::::BEGIN@9 Encode::BEGIN@9
1110s0sEncode::::CORE:match Encode::CORE:match (opcode)
9210s0sEncode::::CORE:subst Encode::CORE:subst (opcode)
0000s0sEncode::Internal::::__ANON__[:309] Encode::Internal::__ANON__[:309]
1110s0sEncode::::LEAVE_SRC Encode::LEAVE_SRC (xsub)
3330s0sEncode::::PERLQQ Encode::PERLQQ (xsub)
1110s0sEncode::::STOP_AT_PARTIAL Encode::STOP_AT_PARTIAL (xsub)
0000s0sEncode::UTF_EBCDIC::::__ANON__[:284]Encode::UTF_EBCDIC::__ANON__[:284]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:296]Encode::UTF_EBCDIC::__ANON__[:296]
1110s0sEncode::::WARN_ON_ERR Encode::WARN_ON_ERR (xsub)
0000s0sEncode::::__ANON__[:165] Encode::__ANON__[:165]
0000s0sEncode::::__ANON__[:194] Encode::__ANON__[:194]
0000s0sEncode::::clone_encoding Encode::clone_encoding
1110s0sEncode::::decode Encode::decode
0000s0sEncode::::decode_utf8 Encode::decode_utf8
69110s0sEncode::::define_encoding Encode::define_encoding
0000s0sEncode::::encode Encode::encode
0000s0sEncode::::encode_utf8 Encode::encode_utf8
0000s0sEncode::::encodings Encode::encodings
8540s0sEncode::::find_encoding Encode::find_encoding (recurses: max depth 1, inclusive time 0s)
0000s0sEncode::::from_to Encode::from_to
8110s0sEncode::::getEncoding Encode::getEncoding (recurses: max depth 1, inclusive time 0s)
0000s0sEncode::::perlio_ok Encode::perlio_ok
1110s0sEncode::::predefine_encodings Encode::predefine_encodings
0000s0sEncode::::resolve_alias Encode::resolve_alias
0000s0sEncode::utf8::::__ANON__[:337] Encode::utf8::__ANON__[:337]
0000s0sEncode::utf8::::__ANON__[:343] Encode::utf8::__ANON__[:343]
0000s0sEncode::utf8::::__ANON__[:359] Encode::utf8::__ANON__[:359]
1110s0sEncode::utf8::::decode_xs Encode::utf8::decode_xs (xsub)
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.70 2015/02/05 10:52:16 dankogai Exp $
3#
4package Encode;
520s20s
# spent 0s within Encode::BEGIN@5 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 5
use strict;
# spent 0s making 1 call to Encode::BEGIN@5 # spent 0s making 1 call to strict::import
620s20s
# spent 0s within Encode::BEGIN@6 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 6
use warnings;
# spent 0s making 1 call to Encode::BEGIN@6 # spent 0s making 1 call to warnings::import
710s10sour $VERSION = sprintf "%d.%02d", q$Revision: 2.70 $ =~ /(\d+)/g;
# spent 0s making 1 call to Encode::CORE:match
820s20s
# spent 0s within Encode::BEGIN@8 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 8
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
# spent 0s making 1 call to Encode::BEGIN@8 # spent 0s making 1 call to constant::import
920s10s
# spent 0s within Encode::BEGIN@9 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 9
use XSLoader ();
# spent 0s making 1 call to Encode::BEGIN@9
1010s10sXSLoader::load( __PACKAGE__, $VERSION );
# spent 0s making 1 call to XSLoader::load
11
1230s30s
# spent 0s within Encode::BEGIN@12 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 12
use Exporter 5.57 'import';
# spent 0s making 1 call to Encode::BEGIN@12 # spent 0s making 1 call to Exporter::import # spent 0s making 1 call to version::vxs::_VERSION
13
14# Public, encouraged API is exported by default
15
1610sour @EXPORT = qw(
17 decode decode_utf8 encode encode_utf8 str2bytes bytes2str
18 encodings find_encoding clone_encoding
19);
2010sour @FB_FLAGS = qw(
21 DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
22 PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
23);
2410sour @FB_CONSTS = qw(
25 FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
26 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
27);
2810sour @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
3610sour %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
4510sour $ON_EBCDIC = ( ord("A") == 193 );
46
4720s20s
# spent 0s within Encode::BEGIN@47 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 47
use Encode::Alias;
# spent 0s making 1 call to Encode::BEGIN@47 # spent 0s making 1 call to Exporter::import
48
49# Make a %Encoding package variable to allow a certain amount of cheating
5010sour %Encoding;
5110sour %ExtModule;
5210srequire 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.
5610seval {
5710s local $SIG{__DIE__};
5810s local $SIG{__WARN__};
5910s require Encode::ConfigLocal;
60};
61
62sub encodings {
63 my %enc;
64 my $arg = $_[1] || '';
65 if ( $arg 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
81sub 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 0s within Encode::define_encoding which was called 69 times, avg 0s/call: # 69 times (0s+0s) by XSLoader::load at line 92 of XSLoader.pm, avg 0s/call
sub define_encoding {
88690s my $obj = shift;
89690s my $name = shift;
90690s $Encoding{$name} = $obj;
91690s my $lc = lc($name);
92690s160s define_alias( $lc => $obj ) unless $lc eq $name;
# spent 0s making 16 calls to Encode::Alias::define_alias, avg 0s/call
93690s while (@_) {
94 my $alias = shift;
95 define_alias( $alias, $obj );
96 }
97690s return $obj;
98}
99
100
# spent 0s within Encode::getEncoding which was called 8 times, avg 0s/call: # 8 times (0s+0s) by Encode::find_encoding at line 128, avg 0s/call
sub getEncoding {
10180s my ( $class, $name, $skip_external ) = @_;
102
10380s80s $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
# spent 0s making 8 calls to Encode::CORE:subst, avg 0s/call
104
10580s ref($name) && $name->can('renew') and return $name;
10680s exists $Encoding{$name} and return $Encoding{$name};
10760s my $lc = lc $name;
10860s exists $Encoding{$lc} and return $Encoding{$lc};
109
11060s60s my $oc = $class->find_alias($name);
# spent 0s making 6 calls to Encode::Alias::find_alias, avg 0s/call, recursion: max depth 1, sum of overlapping time 0s
11160s defined($oc) and return $oc;
11210s $lc ne $name and $oc = $class->find_alias($lc);
11310s defined($oc) and return $oc;
114
11510s unless ($skip_external) {
11610s if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) {
11710s10s $mod =~ s,::,/,g;
# spent 0s making 1 call to Encode::CORE:subst
11810s $mod .= '.pm';
11920s eval { require $mod; };
12010s exists $Encoding{$name} and return $Encoding{$name};
121 }
122 }
123 return;
124}
125
126
# spent 0s within Encode::find_encoding which was called 8 times, avg 0s/call: # 3 times (0s+0s) by ExtUtils::MakeMaker::CORE:binmode at line 1175 of ExtUtils/MakeMaker.pm, avg 0s/call # 2 times (0s+0s) by Encode::Alias::find_alias at line 46 of Encode/Alias.pm, avg 0s/call # once (0s+0s) by ExtUtils::MakeMaker::Locale::_init at line 83 of ExtUtils/MakeMaker/Locale.pm # once (0s+0s) by Encode::Alias::find_alias at line 62 of Encode/Alias.pm # once (0s+0s) by Encode::decode at line 183
sub find_encoding($;$) {
12780s my ( $name, $skip_external ) = @_;
12880s80s return __PACKAGE__->getEncoding( $name, $skip_external );
# spent 0s making 8 calls to Encode::getEncoding, avg 0s/call, recursion: max depth 1, sum of overlapping time 0s
129}
130
131sub resolve_alias($) {
132 my $obj = find_encoding(shift);
133 defined $obj and return $obj->name;
134 return;
135}
136
137sub 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
145sub encode($$;$) {
146 my ( $name, $string, $check ) = @_;
147 return undef unless defined $string;
148 $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 # For Unicode, warnings need to be caught and re-issued at this level
160 # so that callers can disable utf8 warnings lexically.
161 my $octets;
162 if ( ref($enc) eq 'Encode::Unicode' ) {
163 my $warn = '';
164 {
165 local $SIG{__WARN__} = sub { $warn = shift };
166 $octets = $enc->encode( $string, $check );
167 }
168 warnings::warnif('utf8', $warn) if length $warn;
169 }
170 else {
171 $octets = $enc->encode( $string, $check );
172 }
173 $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() );
174 return $octets;
175}
17610s*str2bytes = \&encode;
177
178
# spent 0s within Encode::decode which was called: # once (0s+0s) by Parse::CPAN::Meta::_slurp at line 92 of Parse/CPAN/Meta.pm
sub decode($$;$) {
17910s my ( $name, $octets, $check ) = @_;
18010s return undef unless defined $octets;
18110s $octets .= '';
18210s $check ||= 0;
18310s10s my $enc = find_encoding($name);
# spent 0s making 1 call to Encode::find_encoding
18410s unless ( defined $enc ) {
185 require Carp;
186 Carp::croak("Unknown encoding '$name'");
187 }
188 # For Unicode, warnings need to be caught and re-issued at this level
189 # so that callers can disable utf8 warnings lexically.
19010s my $string;
19110s if ( ref($enc) eq 'Encode::Unicode' ) {
192 my $warn = '';
193 {
194 local $SIG{__WARN__} = sub { $warn = shift };
195 $string = $enc->decode( $octets, $check );
196 }
197 warnings::warnif('utf8', $warn) if length $warn;
198 }
199 else {
20010s20s $string = $enc->decode( $octets, $check );
# spent 0s making 1 call to Encode::Encoding::renewed # spent 0s making 1 call to Encode::utf8::decode_xs
201 }
20210s10s $_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() );
# spent 0s making 1 call to Encode::LEAVE_SRC
20310s return $string;
204}
20510s*bytes2str = \&decode;
206
207sub from_to($$$;$) {
208 my ( $string, $from, $to, $check ) = @_;
209 return undef unless defined $string;
210 $check ||= 0;
211 my $f = find_encoding($from);
212 unless ( defined $f ) {
213 require Carp;
214 Carp::croak("Unknown encoding '$from'");
215 }
216 my $t = find_encoding($to);
217 unless ( defined $t ) {
218 require Carp;
219 Carp::croak("Unknown encoding '$to'");
220 }
221 my $uni = $f->decode($string);
222 $_[0] = $string = $t->encode( $uni, $check );
223 return undef if ( $check && length($uni) );
224 return defined( $_[0] ) ? length($string) : undef;
225}
226
227sub encode_utf8($) {
228 my ($str) = @_;
229 utf8::encode($str);
230 return $str;
231}
232
23310smy $utf8enc;
234
235sub decode_utf8($;$) {
236 my ( $octets, $check ) = @_;
237 return undef unless defined $octets;
238 $octets .= '';
239 $check ||= 0;
240 $utf8enc ||= find_encoding('utf8');
241 my $string = $utf8enc->decode( $octets, $check );
242 $_[0] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() );
243 return $string;
244}
245
246# sub decode_utf8($;$) {
247# my ( $str, $check ) = @_;
248# return $str if is_utf8($str);
249# if ($check) {
250# return decode( "utf8", $str, $check );
251# }
252# else {
253# return decode( "utf8", $str );
254# return $str;
255# }
256# }
257
25810s10spredefine_encodings(1);
# spent 0s making 1 call to Encode::predefine_encodings
259
260#
261# This is to restore %Encoding if really needed;
262#
263
264
# spent 0s within Encode::predefine_encodings which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 258
sub predefine_encodings {
26510s require Encode::Encoding;
26620s20s
# spent 0s within Encode::BEGIN@266 which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 266
no warnings 'redefine';
# spent 0s making 1 call to Encode::BEGIN@266 # spent 0s making 1 call to warnings::unimport
26710s my $use_xs = shift;
26810s if ($ON_EBCDIC) {
269
270 # was in Encode::UTF_EBCDIC
271 package Encode::UTF_EBCDIC;
272 push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding';
273 *decode = sub {
274 my ( undef, $str, $chk ) = @_;
275 my $res = '';
276 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
277 $res .=
278 chr(
279 utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) )
280 );
281 }
282 $_[1] = '' if $chk;
283 return $res;
284 };
285 *encode = sub {
286 my ( undef, $str, $chk ) = @_;
287 my $res = '';
288 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
289 $res .=
290 chr(
291 utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) )
292 );
293 }
294 $_[1] = '' if $chk;
295 return $res;
296 };
297 $Encode::Encoding{Unicode} =
298 bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC";
299 }
300 else {
301
302 package Encode::Internal;
30310s push @Encode::Internal::ISA, 'Encode::Encoding';
304 *decode = sub {
305 my ( undef, $str, $chk ) = @_;
306 utf8::upgrade($str);
307 $_[1] = '' if $chk;
308 return $str;
30910s };
31010s *encode = \&decode;
31110s $Encode::Encoding{Unicode} =
312 bless { Name => "Internal" } => "Encode::Internal";
313 }
314
315 {
316
317 # was in Encode::utf8
31810s package Encode::utf8;
31910s push @Encode::utf8::ISA, 'Encode::Encoding';
320
321 #
32210s if ($use_xs) {
323 Encode::DEBUG and warn __PACKAGE__, " XS on";
32410s *decode = \&decode_xs;
32510s *encode = \&encode_xs;
326 }
327 else {
328 Encode::DEBUG and warn __PACKAGE__, " XS off";
329 *decode = sub {
330 my ( undef, $octets, $chk ) = @_;
331 my $str = Encode::decode_utf8($octets);
332 if ( defined $str ) {
333 $_[1] = '' if $chk;
334 return $str;
335 }
336 return undef;
337 };
338 *encode = sub {
339 my ( undef, $string, $chk ) = @_;
340 my $octets = Encode::encode_utf8($string);
341 $_[1] = '' if $chk;
342 return $octets;
343 };
344 }
345 *cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk)
346 # currently ignores $chk
347 my ( undef, undef, undef, $pos, $trm ) = @_;
348 my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
349215.6ms215.6ms
# spent 15.6ms within Encode::utf8::BEGIN@349 which was called: # once (15.6ms+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 349
use bytes;
# spent 15.6ms making 1 call to Encode::utf8::BEGIN@349 # spent 0s making 1 call to bytes::import
350 if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
351 $$rdst .=
352 substr( $$rsrc, $pos, $npos - $pos + length($trm) );
353 $$rpos = $npos + length($trm);
354 return 1;
355 }
356 $$rdst .= substr( $$rsrc, $pos );
357 $$rpos = length($$rsrc);
358 return '';
35910s };
36010s $Encode::Encoding{utf8} =
361 bless { Name => "utf8" } => "Encode::utf8";
36210s $Encode::Encoding{"utf-8-strict"} =
363 bless { Name => "utf-8-strict", strict_utf8 => 1 }
364 => "Encode::utf8";
365 }
366}
367
36810s1;
369
370__END__
 
# spent 0s within Encode::CORE:match which was called: # once (0s+0s) by ExtUtils::MakeMaker::Locale::BEGIN@13 at line 7
sub Encode::CORE:match; # opcode
# spent 0s within Encode::CORE:subst which was called 9 times, avg 0s/call: # 8 times (0s+0s) by Encode::getEncoding at line 103, avg 0s/call # once (0s+0s) by Encode::getEncoding at line 117
sub Encode::CORE:subst; # opcode
# spent 0s within Encode::LEAVE_SRC which was called: # once (0s+0s) by Encode::decode at line 202
sub Encode::LEAVE_SRC; # xsub
# spent 0s within Encode::PERLQQ which was called 3 times, avg 0s/call: # once (0s+0s) by XSLoader::load at line 92 of XSLoader.pm # once (0s+0s) by Parse::CPAN::Meta::_slurp at line 92 of Parse/CPAN/Meta.pm # once (0s+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::PERLQQ; # xsub
# spent 0s within Encode::STOP_AT_PARTIAL which was called: # once (0s+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::STOP_AT_PARTIAL; # xsub
# spent 0s within Encode::WARN_ON_ERR which was called: # once (0s+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::WARN_ON_ERR; # xsub
# spent 0s within Encode::utf8::decode_xs which was called: # once (0s+0s) by Encode::decode at line 200
sub Encode::utf8::decode_xs; # xsub
Report produced by the NYTProf 5.07 Perl profiler, developed by Tim Bunce and Adam Kaplan.