← Index
NYTProf Performance Profile   « line view »
For opt.pl
  Run on Fri May 8 15:08:12 2015
Reported on Fri May 8 15:08:16 2015

Filename/home/lbr/.plenv/versions/5.20.2/lib/perl5/5.20.2/x86_64-linux/Encode.pm
StatementsExecuted 586 statements in 2.89ms
Subroutines
Calls P F Exclusive
Time
Inclusive
Time
Subroutine
340114.73ms5.00msEncode::utf8::::decode_xs Encode::utf8::decode_xs (xsub)
1111.15ms1.58msEncode::::BEGIN@47 Encode::BEGIN@47
1111.07ms1.97msEncode::::BEGIN@8 Encode::BEGIN@8
5111539µs873µsEncode::::getEncoding Encode::getEncoding (recurses: max depth 1, inclusive time 5µs)
111382µs418µsEncode::::predefine_encodings Encode::predefine_encodings
5122314µs1.18msEncode::::find_encoding Encode::find_encoding (recurses: max depth 1, inclusive time 11µs)
111129µs131µsEncode::utf8::::BEGIN@323 Encode::utf8::BEGIN@323
511149µs49µsEncode::::CORE:subst Encode::CORE:subst (opcode)
11113µs29µsEncode::::BEGIN@12 Encode::BEGIN@12
41112µs12µsEncode::::define_encoding Encode::define_encoding
1118µs21µsEncode::::BEGIN@5 Encode::BEGIN@5
1118µs18µsEncode::::BEGIN@240 Encode::BEGIN@240
1116µs13µsEncode::::BEGIN@6 Encode::BEGIN@6
1114µs4µsEncode::::CORE:match Encode::CORE:match (opcode)
1114µs4µsEncode::::BEGIN@9 Encode::BEGIN@9
2223µs3µsEncode::::PERLQQ Encode::PERLQQ (xsub)
111500ns500nsEncode::::STOP_AT_PARTIAL Encode::STOP_AT_PARTIAL (xsub)
111500ns500nsEncode::::WARN_ON_ERR Encode::WARN_ON_ERR (xsub)
0000s0sEncode::Internal::::__ANON__[:283] Encode::Internal::__ANON__[:283]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:258]Encode::UTF_EBCDIC::__ANON__[:258]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:270]Encode::UTF_EBCDIC::__ANON__[:270]
0000s0sEncode::::clone_encoding Encode::clone_encoding
0000s0sEncode::::decode Encode::decode
0000s0sEncode::::decode_utf8 Encode::decode_utf8
0000s0sEncode::::encode Encode::encode
0000s0sEncode::::encode_utf8 Encode::encode_utf8
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__[:311] Encode::utf8::__ANON__[:311]
0000s0sEncode::utf8::::__ANON__[:317] Encode::utf8::__ANON__[:317]
0000s0sEncode::utf8::::__ANON__[:333] Encode::utf8::__ANON__[:333]
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.60 2014/04/29 16:26:49 dankogai Exp dankogai $
3#
4package Encode;
5217µs234µs
# spent 21µs (8+13) within Encode::BEGIN@5 which was called: # once (8µs+13µs) by DynaLoader::BEGIN@92 at line 5
use strict;
# spent 21µs making 1 call to Encode::BEGIN@5 # spent 13µs making 1 call to strict::import
6243µs219µs
# spent 13µs (6+7) within Encode::BEGIN@6 which was called: # once (6µs+7µs) by DynaLoader::BEGIN@92 at line 6
use warnings;
# spent 13µs making 1 call to Encode::BEGIN@6 # spent 6µs making 1 call to warnings::import
7110µs14µsour $VERSION = sprintf "%d.%02d", q$Revision: 2.60_01 $ =~ /(\d+)/g;
# spent 4µs making 1 call to Encode::CORE:match
8284µs22.01ms
# spent 1.97ms (1.07+900µs) within Encode::BEGIN@8 which was called: # once (1.07ms+900µs) by DynaLoader::BEGIN@92 at line 8
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
# spent 1.97ms making 1 call to Encode::BEGIN@8 # spent 45µs making 1 call to constant::import
9226µs14µs
# spent 4µs within Encode::BEGIN@9 which was called: # once (4µs+0s) by DynaLoader::BEGIN@92 at line 9
use XSLoader ();
# spent 4µs making 1 call to Encode::BEGIN@9
101155µs10sXSLoader::load( __PACKAGE__, $VERSION );
# spent 177µs making 1 call to XSLoader::load, recursion: max depth 1, sum of overlapping time 177µs
11
123112µs345µs
# spent 29µs (13+16) within Encode::BEGIN@12 which was called: # once (13µs+16µs) by DynaLoader::BEGIN@92 at line 12
use Exporter 5.57 'import';
# spent 29µs making 1 call to Encode::BEGIN@12 # spent 8µs making 1 call to UNIVERSAL::VERSION # spent 8µs making 1 call to Exporter::import
13
14# Public, encouraged API is exported by default
15
1611µsour @EXPORT = qw(
17 decode decode_utf8 encode encode_utf8 str2bytes bytes2str
18 encodings find_encoding clone_encoding
19);
201800nsour @FB_FLAGS = qw(
21 DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
22 PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
23);
241800nsour @FB_CONSTS = qw(
25 FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
26 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
27);
2813µ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
3615µ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
451400nsour $ON_EBCDIC = ( ord("A") == 193 );
46
472773µs21.61ms
# spent 1.58ms (1.15+432µs) within Encode::BEGIN@47 which was called: # once (1.15ms+432µs) by DynaLoader::BEGIN@92 at line 47
use Encode::Alias;
# spent 1.58ms making 1 call to Encode::BEGIN@47 # spent 30µs making 1 call to Exporter::import
48
49# Make a %Encoding package variable to allow a certain amount of cheating
501200nsour %Encoding;
511100nsour %ExtModule;
52178µ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.
561300nseval {
5712µs local $SIG{__DIE__};
581800ns local $SIG{__WARN__};
59122µs 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 12µs within Encode::define_encoding which was called 4 times, avg 3µs/call: # 4 times (12µs+0s) by XSLoader::load at line 92 of XSLoader.pm, avg 3µs/call
sub define_encoding {
884900ns my $obj = shift;
8941µs my $name = shift;
9042µs $Encoding{$name} = $obj;
9142µs my $lc = lc($name);
924800ns define_alias( $lc => $obj ) unless $lc eq $name;
9341µs while (@_) {
94 my $alias = shift;
95 define_alias( $alias, $obj );
96 }
9748µs return $obj;
98}
99
100
# spent 873µs (539+334) within Encode::getEncoding which was called 51 times, avg 17µs/call: # 51 times (539µs+334µs) by Encode::find_encoding at line 128, avg 17µs/call
sub getEncoding {
1015132µs my ( $class, $name, $skip_external ) = @_;
102
10351177µs5149µs $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
# spent 49µs making 51 calls to Encode::CORE:subst, avg 963ns/call
104
1055117µs ref($name) && $name->can('renew') and return $name;
1065159µs exists $Encoding{$name} and return $Encoding{$name};
1075045µs my $lc = lc $name;
1085028µs exists $Encoding{$lc} and return $Encoding{$lc};
109
11050122µs50291µs my $oc = $class->find_alias($name);
# spent 291µs making 50 calls to Encode::Alias::find_alias, avg 6µs/call
11150113µs 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
# spent 1.18ms (314µs+868µs) within Encode::find_encoding which was called 51 times, avg 23µs/call: # 50 times (309µs+873µs) by main::CORE:open at line 53 of opt.pl, avg 24µs/call # once (6µs+-6µs) by Encode::Alias::find_alias at line 46 of Encode/Alias.pm
sub find_encoding($;$) {
1275133µs my ( $name, $skip_external ) = @_;
12851271µs51873µs return __PACKAGE__->getEncoding( $name, $skip_external );
# spent 879µs making 51 calls to Encode::getEncoding, avg 17µs/call, recursion: max depth 1, sum of overlapping time 5µs
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 my $octets = $enc->encode( $string, $check );
160 $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() );
161 return $octets;
162}
16311µs*str2bytes = \&encode;
164
165sub decode($$;$) {
166 my ( $name, $octets, $check ) = @_;
167 return undef unless defined $octets;
168 $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}
1791400ns*bytes2str = \&decode;
180
181sub 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
201sub encode_utf8($) {
202 my ($str) = @_;
203 utf8::encode($str);
204 return $str;
205}
206
2071200nsmy $utf8enc;
208
209sub decode_utf8($;$) {
210 my ( $octets, $check ) = @_;
211 return undef unless defined $octets;
212 $octets .= '';
213 $check ||= 0;
214 $utf8enc ||= find_encoding('utf8');
215 my $string = $utf8enc->decode( $octets, $check );
216 $_[0] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() );
217 return $string;
218}
219
220# sub decode_utf8($;$) {
221# my ( $str, $check ) = @_;
222# return $str if is_utf8($str);
223# if ($check) {
224# return decode( "utf8", $str, $check );
225# }
226# else {
227# return decode( "utf8", $str );
228# return $str;
229# }
230# }
231
23211µs1418µspredefine_encodings(1);
# spent 418µs making 1 call to Encode::predefine_encodings
233
234#
235# This is to restore %Encoding if really needed;
236#
237
238
# spent 418µs (382+36) within Encode::predefine_encodings which was called: # once (382µs+36µs) by DynaLoader::BEGIN@92 at line 232
sub predefine_encodings {
239168µs require Encode::Encoding;
2402320µs229µs
# spent 18µs (8+10) within Encode::BEGIN@240 which was called: # once (8µs+10µs) by DynaLoader::BEGIN@92 at line 240
no warnings 'redefine';
# spent 18µs making 1 call to Encode::BEGIN@240 # spent 10µs making 1 call to warnings::unimport
2411400ns my $use_xs = shift;
2421400ns if ($ON_EBCDIC) {
243
244 # was in Encode::UTF_EBCDIC
245 package Encode::UTF_EBCDIC;
246 push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding';
247 *decode = sub {
248 my ( undef, $str, $chk ) = @_;
249 my $res = '';
250 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
251 $res .=
252 chr(
253 utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) )
254 );
255 }
256 $_[1] = '' if $chk;
257 return $res;
258 };
259 *encode = sub {
260 my ( undef, $str, $chk ) = @_;
261 my $res = '';
262 for ( my $i = 0 ; $i < length($str) ; $i++ ) {
263 $res .=
264 chr(
265 utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) )
266 );
267 }
268 $_[1] = '' if $chk;
269 return $res;
270 };
271 $Encode::Encoding{Unicode} =
272 bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC";
273 }
274 else {
275
276 package Encode::Internal;
27716µs push @Encode::Internal::ISA, 'Encode::Encoding';
278 *decode = sub {
279 my ( undef, $str, $chk ) = @_;
280 utf8::upgrade($str);
281 $_[1] = '' if $chk;
282 return $str;
28312µs };
2841200ns *encode = \&decode;
28512µs $Encode::Encoding{Unicode} =
286 bless { Name => "Internal" } => "Encode::Internal";
287 }
288
289 {
290
291 # was in Encode::utf8
29213µs package Encode::utf8;
29312µs push @Encode::utf8::ISA, 'Encode::Encoding';
294
295 #
2961300ns if ($use_xs) {
297 Encode::DEBUG and warn __PACKAGE__, " XS on";
2981600ns *decode = \&decode_xs;
2991300ns *encode = \&encode_xs;
300 }
301 else {
302 Encode::DEBUG and warn __PACKAGE__, " XS off";
303 *decode = sub {
304 my ( undef, $octets, $chk ) = @_;
305 my $str = Encode::decode_utf8($octets);
306 if ( defined $str ) {
307 $_[1] = '' if $chk;
308 return $str;
309 }
310 return undef;
311 };
312 *encode = sub {
313 my ( undef, $string, $chk ) = @_;
314 my $octets = Encode::encode_utf8($string);
315 $_[1] = '' if $chk;
316 return $octets;
317 };
318 }
319 *cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk)
320 # currently ignores $chk
321 my ( undef, undef, undef, $pos, $trm ) = @_;
322 my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
3232225µs2133µs
# spent 131µs (129+2) within Encode::utf8::BEGIN@323 which was called: # once (129µs+2µs) by DynaLoader::BEGIN@92 at line 323
use bytes;
# spent 131µs making 1 call to Encode::utf8::BEGIN@323 # spent 2µs making 1 call to bytes::import
324 if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
325 $$rdst .=
326 substr( $$rsrc, $pos, $npos - $pos + length($trm) );
327 $$rpos = $npos + length($trm);
328 return 1;
329 }
330 $$rdst .= substr( $$rsrc, $pos );
331 $$rpos = length($$rsrc);
332 return '';
33312µs };
33412µs $Encode::Encoding{utf8} =
335 bless { Name => "utf8" } => "Encode::utf8";
33612µs $Encode::Encoding{"utf-8-strict"} =
337 bless { Name => "utf-8-strict", strict_utf8 => 1 }
338 => "Encode::utf8";
339 }
340}
341
34218µs1;
343
344__END__
 
# spent 4µs within Encode::CORE:match which was called: # once (4µs+0s) by DynaLoader::BEGIN@92 at line 7
sub Encode::CORE:match; # opcode
# spent 49µs within Encode::CORE:subst which was called 51 times, avg 963ns/call: # 51 times (49µs+0s) by Encode::getEncoding at line 103, avg 963ns/call
sub Encode::CORE:subst; # opcode
# spent 3µs within Encode::PERLQQ which was called 2 times, avg 1µs/call: # once (2µs+0s) by XSLoader::load at line 92 of XSLoader.pm # once (600ns+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::PERLQQ; # xsub
# spent 500ns within Encode::STOP_AT_PARTIAL which was called: # once (500ns+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::STOP_AT_PARTIAL; # xsub
# spent 500ns within Encode::WARN_ON_ERR which was called: # once (500ns+0s) by PerlIO::import at line 16 of PerlIO/encoding.pm
sub Encode::WARN_ON_ERR; # xsub
# spent 5.00ms (4.73+270µs) within Encode::utf8::decode_xs which was called 340 times, avg 15µs/call: # 340 times (4.73ms+270µs) by main::CORE:readline at line 54 of opt.pl, avg 15µs/call
sub Encode::utf8::decode_xs; # xsub