← Index
NYTProf Performance Profile   « line view »
For webmerge/scripts/webmerge.pl
  Run on Mon Oct 7 02:42:42 2013
Reported on Mon Oct 7 03:03:25 2013

Filename/usr/lib64/perl5/vendor_perl/5.16.0/x86_64-linux/Encode.pm
StatementsExecuted 80 statements in 83.1ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
1119.15ms14.4msEncode::::BEGIN@48 Encode::BEGIN@48
1113.16ms3.50msEncode::::predefine_encodings Encode::predefine_encodings
411106µs106µsEncode::::define_encoding Encode::define_encoding
11177µs177µsEncode::::BEGIN@5 Encode::BEGIN@5
11175µs155µsEncode::::BEGIN@241 Encode::BEGIN@241
11171µs88µsEncode::utf8::::BEGIN@324 Encode::utf8::BEGIN@324
11168µs68µsEncode::::BEGIN@9 Encode::BEGIN@9
11157µs295µsEncode::::BEGIN@8 Encode::BEGIN@8
11156µs88µsEncode::::BEGIN@6 Encode::BEGIN@6
11155µs438µsEncode::::BEGIN@13 Encode::BEGIN@13
11127µs27µsEncode::::CORE:match Encode::CORE:match (opcode)
0000s0sEncode::Internal::::__ANON__[:284] Encode::Internal::__ANON__[:284]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:259]Encode::UTF_EBCDIC::__ANON__[:259]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:271]Encode::UTF_EBCDIC::__ANON__[:271]
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::::find_encoding Encode::find_encoding
0000s0sEncode::::from_to Encode::from_to
0000s0sEncode::::getEncoding Encode::getEncoding
0000s0sEncode::::perlio_ok Encode::perlio_ok
0000s0sEncode::::resolve_alias Encode::resolve_alias
0000s0sEncode::utf8::::__ANON__[:312] Encode::utf8::__ANON__[:312]
0000s0sEncode::utf8::::__ANON__[:318] Encode::utf8::__ANON__[:318]
0000s0sEncode::utf8::::__ANON__[:334] Encode::utf8::__ANON__[:334]
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.47 2012/08/15 05:36:16 dankogai Exp dankogai $
3#
4package Encode;
52168µs2276µ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
use strict;
# spent 177µs making 1 call to Encode::BEGIN@5 # spent 99µs making 1 call to strict::import
62329µs2120µ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
use warnings;
# spent 88µs making 1 call to Encode::BEGIN@6 # spent 32µs making 1 call to warnings::import
7180µs127µsour $VERSION = sprintf "%d.%02d", q$Revision: 2.47 $ =~ /(\d+)/g;
# spent 27µs making 1 call to Encode::CORE:match
82209µs2533µ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
use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG};
# spent 295µs making 1 call to Encode::BEGIN@8 # spent 238µs making 1 call to constant::import
92240µs168µs
# spent 68µs within Encode::BEGIN@9 which was called: # once (68µs+0s) by Pod::Text::BEGIN@32 at line 9
use XSLoader ();
# spent 68µs making 1 call to Encode::BEGIN@9
10168.4ms168.6msXSLoader::load( __PACKAGE__, $VERSION );
# spent 68.6ms making 1 call to XSLoader::load
11
1214µsrequire Exporter;
132832µs2822µ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
use base qw/Exporter/;
# 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
17113µsour @EXPORT = qw(
18 decode decode_utf8 encode encode_utf8 str2bytes bytes2str
19 encodings find_encoding clone_encoding
20);
2119µsour @FB_FLAGS = qw(
22 DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
23 PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
24);
2518µsour @FB_CONSTS = qw(
26 FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
27 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
28);
29120µsour @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
37164µsour %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
4613µsour $ON_EBCDIC = ( ord("A") == 193 );
47
4826.86ms214.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
use Encode::Alias;
# 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
511900nsour %Encoding;
5211µsour %ExtModule;
531732µsrequire 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.
5713µseval {
58116µs local $SIG{__DIE__};
5919µs local $SIG{__WARN__};
601297µs require Encode::ConfigLocal;
61};
62
63sub 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
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 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
sub define_encoding {
8849µs my $obj = shift;
8946µs my $name = shift;
90419µs $Encoding{$name} = $obj;
9149µs my $lc = lc($name);
9247µs define_alias( $lc => $obj ) unless $lc eq $name;
93415µs while (@_) {
94 my $alias = shift;
95 define_alias( $alias, $obj );
96 }
97478µs return $obj;
98}
99
100sub 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
126sub find_encoding($;$) {
127 my ( $name, $skip_external ) = @_;
128 return __PACKAGE__->getEncoding( $name, $skip_external );
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 .= '' 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}
163112µs*str2bytes = \&encode;
164
165sub 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}
17914µs*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
20712µsmy $utf8enc;
208
209sub 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
233117µs13.50mspredefine_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
sub predefine_encodings {
2401461µs require Encode::Encoding;
24123.01ms2236µ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
no warnings 'redefine';
# spent 155µs making 1 call to Encode::BEGIN@241 # spent 80µs making 1 call to warnings::unimport
24214µs my $use_xs = shift;
24314µ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;
278148µ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;
284116µs };
28513µs *encode = \&decode;
286137µs $Encode::Encoding{Unicode} =
287 bless { Name => "Internal" } => "Encode::Internal";
288 }
289
290 {
291
292 # was in Encode::utf8
293127µs package Encode::utf8;
294118µs push @Encode::utf8::ISA, 'Encode::Encoding';
295
296 #
29714µs if ($use_xs) {
298 Encode::DEBUG and warn __PACKAGE__, " XS on";
29915µs *decode = \&decode_xs;
30014µ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 ];
3242789µs2105µ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
use bytes;
# 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 '';
334120µs };
335125µs $Encode::Encoding{utf8} =
336 bless { Name => "utf8" } => "Encode::utf8";
337114µs $Encode::Encoding{"utf-8-strict"} =
338 bless { Name => "utf-8-strict", strict_utf8 => 1 }
339 => "Encode::utf8";
340 }
341}
342
343184µs1;
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
sub Encode::CORE:match; # opcode
Report produced by the NYTProf 5.05 Perl profiler, developed by Tim Bunce and Adam Kaplan.