Profile of Encode.pm

← Index
NYTProf Performance Profile «line view»
For t/bug-md-11.t
Run on Fri Mar 8 13:27:24 2024
Reported on Fri Mar 8 13:30:23 2024

Filename | /home/micha/.plenv/versions/5.38.2/lib/perl5/site_perl/5.38.2/x86_64-linux/Encode.pm
Statements | Executed 123 statements in 1.54ms

Subroutines
Calls | P | F | Exclusive Time | Inclusive Time | Subroutine
--- | --- | --- | --- | --- | ---
1 | 1 | 1 | 1.57ms | 1.87ms | Encode::::BEGIN@56 Encode::BEGIN@56
1 | 1 | 1 | 1.20ms | 1.51ms | Encode::::BEGIN@53 Encode::BEGIN@53
1 | 1 | 1 | 317µs | 350µs | Encode::::BEGIN@54 Encode::BEGIN@54
7 | 2 | 1 | 16µs | 16µs | Encode::::define_encoding Encode::define_encoding
1 | 1 | 1 | 14µs | 25µs | Encode::::onBOOT Encode::onBOOT (xsub)
1 | 1 | 1 | 9µs | 153µs | Encode::::BEGIN@9 Encode::BEGIN@9
1 | 1 | 1 | 9µs | 10µs | Encode::utf8::::BEGIN@229 Encode::utf8::BEGIN@229
1 | 1 | 1 | 9µs | 10µs | Encode::::BEGIN@5 Encode::BEGIN@5
1 | 1 | 1 | 7µs | 16µs | Encode::::BEGIN@15 Encode::BEGIN@15
1 | 1 | 1 | 6µs | 467µs | Encode::UTF_EBCDIC::::BEGIN@178Encode::UTF_EBCDIC::BEGIN@178
1 | 1 | 1 | 5µs | 18µs | Encode::XS::::BEGIN@210 Encode::XS::BEGIN@210
1 | 1 | 1 | 4µs | 17µs | Encode::utf8::::BEGIN@215 Encode::utf8::BEGIN@215
1 | 1 | 1 | 4µs | 25µs | Encode::::BEGIN@7 Encode::BEGIN@7
1 | 1 | 1 | 3µs | 19µs | Encode::::BEGIN@6 Encode::BEGIN@6
1 | 1 | 1 | 2µs | 2µs | Encode::::BEGIN@17 Encode::BEGIN@17
1 | 1 | 1 | 600ns | 600ns | Encode::::__ANON__ Encode::__ANON__ (xsub)
0 | 0 | 0 | 0s | 0s | Encode::UTF_EBCDIC::::decodeEncode::UTF_EBCDIC::decode
0 | 0 | 0 | 0s | 0s | Encode::UTF_EBCDIC::::encodeEncode::UTF_EBCDIC::encode
0 | 0 | 0 | 0s | 0s | Encode::::clone_encoding Encode::clone_encoding
0 | 0 | 0 | 0s | 0s | Encode::::define_alias Encode::define_alias
0 | 0 | 0 | 0s | 0s | Encode::::encodings Encode::encodings
0 | 0 | 0 | 0s | 0s | Encode::::find_alias Encode::find_alias
0 | 0 | 0 | 0s | 0s | Encode::::find_encoding Encode::find_encoding
0 | 0 | 0 | 0s | 0s | Encode::::find_mime_encoding Encode::find_mime_encoding
0 | 0 | 0 | 0s | 0s | Encode::::getEncoding Encode::getEncoding
0 | 0 | 0 | 0s | 0s | Encode::::perlio_ok Encode::perlio_ok
0 | 0 | 0 | 0s | 0s | Encode::::resolve_alias Encode::resolve_alias
0 | 0 | 0 | 0s | 0s | Encode::utf8::::cat_decode Encode::utf8::cat_decode

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 3.21 2024/02/25 22:17:32 dankogai Exp $
3 |  |  |  |  | #
4 |  |  |  |  | package Encode;
5 | 2 | 16µs | 2 | 12µs | # spent 10µs (9+2) within Encode::BEGIN@5 which was called: # once (9µs+2µs) by Archive::Zip::Archive::BEGIN@12 at line 5 use strict; # spent 10µs making 1 call to Encode::BEGIN@5 # spent 2µs making 1 call to strict::import
6 | 2 | 19µs | 2 | 35µs | # spent 19µs (3+16) within Encode::BEGIN@6 which was called: # once (3µs+16µs) by Archive::Zip::Archive::BEGIN@12 at line 6 use warnings; # spent 19µs making 1 call to Encode::BEGIN@6 # spent 16µs making 1 call to warnings::import
7 | 2 | 48µs | 2 | 46µs | # spent 25µs (4+21) within Encode::BEGIN@7 which was called: # once (4µs+21µs) by Archive::Zip::Archive::BEGIN@12 at line 7 use constant DEBUG => !!$ENV{PERL_ENCODE_DEBUG}; # spent 25µs making 1 call to Encode::BEGIN@7 # spent 21µs making 1 call to constant::import
8 |  |  |  |  | our $VERSION;
9 |  |  |  |  | # spent 153µs (9+144) within Encode::BEGIN@9 which was called: # once (9µs+144µs) by Archive::Zip::Archive::BEGIN@12 at line 13 BEGIN {
10 | 1 | 7µs | 1 | 3µs | $VERSION = sprintf "%d.%02d", q$Revision: 3.21 $ =~ /(\d+)/g; # spent 3µs making 1 call to CORE::match
11 | 1 | 200ns |  |  | require XSLoader;
12 | 1 | 146µs | 1 | 141µs | XSLoader::load( __PACKAGE__, $VERSION ); # spent 141µs making 1 call to XSLoader::load
13 | 1 | 25µs | 1 | 153µs | } # spent 153µs making 1 call to Encode::BEGIN@9
14 |  |  |  |  |
15 | 3 | 21µs | 3 | 25µs | # spent 16µs (7+9) within Encode::BEGIN@15 which was called: # once (7µs+9µs) by Archive::Zip::Archive::BEGIN@12 at line 15 use Exporter 5.57 'import'; # spent 16µs making 1 call to Encode::BEGIN@15 # spent 5µs making 1 call to UNIVERSAL::VERSION # spent 4µs making 1 call to Exporter::import
16 |  |  |  |  |
17 | 2 | 93µs | 1 | 2µs | # spent 2µs within Encode::BEGIN@17 which was called: # once (2µs+0s) by Archive::Zip::Archive::BEGIN@12 at line 17 use Carp (); # spent 2µs making 1 call to Encode::BEGIN@17
18 | 1 | 700ns |  |  | our @CARP_NOT = qw(Encode::Encoder);
19 |  |  |  |  |
20 |  |  |  |  | # Public, encouraged API is exported by default
21 |  |  |  |  |
22 | 1 | 1µs |  |  | our @EXPORT = qw(
23 |  |  |  |  | decode decode_utf8 encode encode_utf8 str2bytes bytes2str
24 |  |  |  |  | encodings find_encoding find_mime_encoding clone_encoding
25 |  |  |  |  | );
26 | 1 | 600ns |  |  | our @FB_FLAGS = qw(
27 |  |  |  |  | DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
28 |  |  |  |  | PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
29 |  |  |  |  | );
30 | 1 | 400ns |  |  | our @FB_CONSTS = qw(
31 |  |  |  |  | FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
32 |  |  |  |  | FB_PERLQQ FB_HTMLCREF FB_XMLCREF
33 |  |  |  |  | );
34 | 1 | 1µs |  |  | our @EXPORT_OK = (
35 |  |  |  |  | qw(
36 |  |  |  |  | _utf8_off _utf8_on define_encoding from_to is_16bit is_8bit
37 |  |  |  |  | is_utf8 perlio_ok resolve_alias utf8_downgrade utf8_upgrade
38 |  |  |  |  | ),
39 |  |  |  |  | @FB_FLAGS, @FB_CONSTS,
40 |  |  |  |  | );
41 |  |  |  |  |
42 | 1 | 4µs |  |  | our %EXPORT_TAGS = (
43 |  |  |  |  | all => [ @EXPORT, @EXPORT_OK ],
44 |  |  |  |  | default => [ @EXPORT ],
45 |  |  |  |  | fallbacks => [ @FB_CONSTS ],
46 |  |  |  |  | fallback_all => [ @FB_CONSTS, @FB_FLAGS ],
47 |  |  |  |  | );
48 |  |  |  |  |
49 |  |  |  |  | # Documentation moved after __END__ for speed - NI-S
50 |  |  |  |  |
51 | 1 | 300ns |  |  | our $ON_EBCDIC = ( ord("A") == 193 );
52 |  |  |  |  |
53 | 2 | 76µs | 1 | 1.51ms | # spent 1.51ms (1.20+314µs) within Encode::BEGIN@53 which was called: # once (1.20ms+314µs) by Archive::Zip::Archive::BEGIN@12 at line 53 use Encode::Alias (); # spent 1.51ms making 1 call to Encode::BEGIN@53
54 | 2 | 83µs | 2 | 350µs | # spent 350µs (317+33) within Encode::BEGIN@54 which was called: # once (317µs+33µs) by Archive::Zip::Archive::BEGIN@12 at line 54 use Encode::MIME::Name; # spent 350µs making 1 call to Encode::BEGIN@54 # spent 600ns making 1 call to Encode::__ANON__
55 |  |  |  |  |
56 | 2 | 524µs | 2 | 1.89ms | # spent 1.87ms (1.57+302µs) within Encode::BEGIN@56 which was called: # once (1.57ms+302µs) by Archive::Zip::Archive::BEGIN@12 at line 56 use Storable; # spent 1.87ms making 1 call to Encode::BEGIN@56 # spent 20µs making 1 call to Exporter::import
57 |  |  |  |  |
58 |  |  |  |  | # Make a %Encoding package variable to allow a certain amount of cheating
59 |  |  |  |  | our %Encoding;
60 |  |  |  |  | our %ExtModule;
61 | 1 | 85µs |  |  | require Encode::Config;
62 |  |  |  |  | # See
63 |  |  |  |  | # https://bugzilla.redhat.com/show_bug.cgi?id=435505#c2
64 |  |  |  |  | # to find why sig handlers inside eval{} are disabled.
65 | 1 | 200ns |  |  | eval {
66 | 1 | 1µs |  |  | local $SIG{__DIE__};
67 | 1 | 500ns |  |  | local $SIG{__WARN__};
68 | 1 | 900ns |  |  | local @INC = @INC;
69 | 1 | 500ns |  |  | pop @INC if @INC && $INC[-1] eq '.';
70 | 1 | 26µs |  |  | require Encode::ConfigLocal;
71 |  |  |  |  | };
72 |  |  |  |  |
73 |  |  |  |  | sub encodings {
74 |  |  |  |  | my %enc;
75 |  |  |  |  | my $arg = $_[1] || '';
76 |  |  |  |  | if ( $arg eq ":all" ) {
77 |  |  |  |  | %enc = ( %Encoding, %ExtModule );
78 |  |  |  |  | }
79 |  |  |  |  | else {
80 |  |  |  |  | %enc = %Encoding;
81 |  |  |  |  | for my $mod ( map { m/::/ ? $_ : "Encode::$_" } @_ ) {
82 |  |  |  |  | DEBUG and warn $mod;
83 |  |  |  |  | for my $enc ( keys %ExtModule ) {
84 |  |  |  |  | $ExtModule{$enc} eq $mod and $enc{$enc} = $mod;
85 |  |  |  |  | }
86 |  |  |  |  | }
87 |  |  |  |  | }
88 |  |  |  |  | return sort { lc $a cmp lc $b }
89 |  |  |  |  | grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc;
90 |  |  |  |  | }
91 |  |  |  |  |
92 |  |  |  |  | sub perlio_ok {
93 |  |  |  |  | my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] );
94 |  |  |  |  | $obj->can("perlio_ok") and return $obj->perlio_ok();
95 |  |  |  |  | return 0; # safety net
96 |  |  |  |  | }
97 |  |  |  |  |
98 |  |  |  |  | # spent 16µs within Encode::define_encoding which was called 7 times, avg 2µs/call: # 5 times (12µs+0s) by Encode::onBOOT at line 174, avg 2µs/call # 2 times (4µs+0s) by Archive::Zip::Archive::BEGIN@12 at line 222, avg 2µs/call sub define_encoding {
99 | 7 | 500ns |  |  | my $obj = shift;
100 | 7 | 1µs |  |  | my $name = shift;
101 | 7 | 2µs |  |  | $Encoding{$name} = $obj;
102 | 7 | 2µs |  |  | my $lc = lc($name);
103 | 7 | 800ns |  |  | define_alias( $lc => $obj ) unless $lc eq $name;
104 | 7 | 1µs |  |  | while (@_) {
105 |  |  |  |  | my $alias = shift;
106 |  |  |  |  | define_alias( $alias, $obj );
107 |  |  |  |  | }
108 | 7 | 1µs |  |  | my $class = ref($obj);
109 | 7 | 3µs |  |  | push @Encode::CARP_NOT, $class unless grep { $_ eq $class } @Encode::CARP_NOT;
110 | 7 | 2µs |  |  | push @Encode::Encoding::CARP_NOT, $class unless grep { $_ eq $class } @Encode::Encoding::CARP_NOT;
111 | 7 | 7µs |  |  | return $obj;
112 |  |  |  |  | }
113 |  |  |  |  |
114 |  |  |  |  | sub getEncoding {
115 |  |  |  |  | my ( $class, $name, $skip_external ) = @_;
116 |  |  |  |  |
117 |  |  |  |  | defined($name) or return;
118 |  |  |  |  |
119 |  |  |  |  | $name =~ s/\s+//g; # https://rt.cpan.org/Ticket/Display.html?id=65796
120 |  |  |  |  |
121 |  |  |  |  | ref($name) && $name->can('renew') and return $name;
122 |  |  |  |  | exists $Encoding{$name} and return $Encoding{$name};
123 |  |  |  |  | my $lc = lc $name;
124 |  |  |  |  | exists $Encoding{$lc} and return $Encoding{$lc};
125 |  |  |  |  |
126 |  |  |  |  | my $oc = $class->find_alias($name);
127 |  |  |  |  | defined($oc) and return $oc;
128 |  |  |  |  | $lc ne $name and $oc = $class->find_alias($lc);
129 |  |  |  |  | defined($oc) and return $oc;
130 |  |  |  |  |
131 |  |  |  |  | unless ($skip_external) {
132 |  |  |  |  | if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) {
133 |  |  |  |  | $mod =~ s,::,/,g;
134 |  |  |  |  | $mod .= '.pm';
135 |  |  |  |  | eval { require $mod; };
136 |  |  |  |  | exists $Encoding{$name} and return $Encoding{$name};
137 |  |  |  |  | }
138 |  |  |  |  | }
139 |  |  |  |  | return;
140 |  |  |  |  | }
141 |  |  |  |  |
142 |  |  |  |  | # HACK: These two functions must be defined in Encode and because of
143 |  |  |  |  | # cyclic dependency between Encode and Encode::Alias, Exporter does not work
144 |  |  |  |  | sub find_alias {
145 |  |  |  |  | goto &Encode::Alias::find_alias;
146 |  |  |  |  | }
147 |  |  |  |  | sub define_alias {
148 |  |  |  |  | goto &Encode::Alias::define_alias;
149 |  |  |  |  | }
150 |  |  |  |  |
151 |  |  |  |  | sub find_encoding($;$) {
152 |  |  |  |  | my ( $name, $skip_external ) = @_;
153 |  |  |  |  | return __PACKAGE__->getEncoding( $name, $skip_external );
154 |  |  |  |  | }
155 |  |  |  |  |
156 |  |  |  |  | sub find_mime_encoding($;$) {
157 |  |  |  |  | my ( $mime_name, $skip_external ) = @_;
158 |  |  |  |  | my $name = Encode::MIME::Name::get_encode_name( $mime_name );
159 |  |  |  |  | return find_encoding( $name, $skip_external );
160 |  |  |  |  | }
161 |  |  |  |  |
162 |  |  |  |  | sub resolve_alias($) {
163 |  |  |  |  | my $obj = find_encoding(shift);
164 |  |  |  |  | defined $obj and return $obj->name;
165 |  |  |  |  | return;
166 |  |  |  |  | }
167 |  |  |  |  |
168 |  |  |  |  | sub clone_encoding($) {
169 |  |  |  |  | my $obj = find_encoding(shift);
170 |  |  |  |  | ref $obj or return;
171 |  |  |  |  | return Storable::dclone($obj);
172 |  |  |  |  | }
173 |  |  |  |  |
174 | 1 | 13µs | 6 | 37µs | onBOOT; # spent 25µs making 1 call to Encode::onBOOT # spent 12µs making 5 calls to Encode::define_encoding, avg 2µs/call
175 |  |  |  |  |
176 | 1 | 200ns |  |  | if ($ON_EBCDIC) {
177 |  |  |  |  | package Encode::UTF_EBCDIC;
178 | 2 | 122µs | 2 | 929µs | # spent 467µs (6+462) within Encode::UTF_EBCDIC::BEGIN@178 which was called: # once (6µs+462µs) by Archive::Zip::Archive::BEGIN@12 at line 178 use parent 'Encode::Encoding'; # spent 467µs making 1 call to Encode::UTF_EBCDIC::BEGIN@178 # spent 462µs making 1 call to parent::import
179 |  |  |  |  | my $obj = bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC";
180 |  |  |  |  | Encode::define_encoding($obj, 'Unicode');
181 |  |  |  |  | sub decode {
182 |  |  |  |  | my ( undef, $str, $chk ) = @_;
183 |  |  |  |  | my $res = '';
184 |  |  |  |  | for ( my $i = 0 ; $i < length($str) ; $i++ ) {
185 |  |  |  |  | $res .=
186 |  |  |  |  | chr(
187 |  |  |  |  | utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) )
188 |  |  |  |  | );
189 |  |  |  |  | }
190 |  |  |  |  | $_[1] = '' if $chk;
191 |  |  |  |  | return $res;
192 |  |  |  |  | }
193 |  |  |  |  | sub encode {
194 |  |  |  |  | my ( undef, $str, $chk ) = @_;
195 |  |  |  |  | my $res = '';
196 |  |  |  |  | for ( my $i = 0 ; $i < length($str) ; $i++ ) {
197 |  |  |  |  | $res .=
198 |  |  |  |  | chr(
199 |  |  |  |  | utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) )
200 |  |  |  |  | );
201 |  |  |  |  | }
202 |  |  |  |  | $_[1] = '' if $chk;
203 |  |  |  |  | return $res;
204 |  |  |  |  | }
205 |  |  |  |  | }
206 |  |  |  |  |
207 |  |  |  |  | {
208 |  |  |  |  | # https://rt.cpan.org/Public/Bug/Display.html?id=103253
209 |  |  |  |  | package Encode::XS;
210 | 2 | 27µs | 2 | 31µs | # spent 18µs (5+13) within Encode::XS::BEGIN@210 which was called: # once (5µs+13µs) by Archive::Zip::Archive::BEGIN@12 at line 210 use parent 'Encode::Encoding'; # spent 18µs making 1 call to Encode::XS::BEGIN@210 # spent 13µs making 1 call to parent::import
211 |  |  |  |  | }
212 |  |  |  |  |
213 |  |  |  |  | {
214 | 1 | 300ns |  |  | package Encode::utf8;
215 | 2 | 85µs | 2 | 30µs | # spent 17µs (4+13) within Encode::utf8::BEGIN@215 which was called: # once (4µs+13µs) by Archive::Zip::Archive::BEGIN@12 at line 215 use parent 'Encode::Encoding'; # spent 17µs making 1 call to Encode::utf8::BEGIN@215 # spent 13µs making 1 call to parent::import
216 | 1 | 2µs |  |  | my %obj = (
217 |  |  |  |  | 'utf8' => { Name => 'utf8' },
218 |  |  |  |  | 'utf-8-strict' => { Name => 'utf-8-strict', strict_utf8 => 1 }
219 |  |  |  |  | );
220 | 1 | 1µs |  |  | for ( keys %obj ) {
221 | 2 | 500ns |  |  | bless $obj{$_} => __PACKAGE__;
222 | 2 | 1µs | 2 | 4µs | Encode::define_encoding( $obj{$_} => $_ ); # spent 4µs making 2 calls to Encode::define_encoding, avg 2µs/call
223 |  |  |  |  | }
224 |  |  |  |  | sub cat_decode {
225 |  |  |  |  | # ($obj, $dst, $src, $pos, $trm, $chk)
226 |  |  |  |  | # currently ignores $chk
227 |  |  |  |  | my ( undef, undef, undef, $pos, $trm ) = @_;
228 |  |  |  |  | my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ];
229 | 2 | 80µs | 2 | 12µs | # spent 10µs (9+1) within Encode::utf8::BEGIN@229 which was called: # once (9µs+1µs) by Archive::Zip::Archive::BEGIN@12 at line 229 use bytes; # spent 10µs making 1 call to Encode::utf8::BEGIN@229 # spent 1µs making 1 call to bytes::import
230 |  |  |  |  | if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) {
231 |  |  |  |  | $$rdst .=
232 |  |  |  |  | substr( $$rsrc, $pos, $npos - $pos + length($trm) );
233 |  |  |  |  | $$rpos = $npos + length($trm);
234 |  |  |  |  | return 1;
235 |  |  |  |  | }
236 |  |  |  |  | $$rdst .= substr( $$rsrc, $pos );
237 |  |  |  |  | $$rpos = length($$rsrc);
238 |  |  |  |  | return '';
239 |  |  |  |  | }
240 |  |  |  |  | }
241 |  |  |  |  |
242 | 2 | 10µs |  |  | 1;
243 |  |  |  |  |
244 |  |  |  |  | __END__
|  |  |  |  | # spent 600ns within Encode::__ANON__ which was called: # once (600ns+0s) by Encode::BEGIN@54 at line 54 sub Encode::__ANON__; # xsub
|  |  |  |  | # spent 25µs (14+12) within Encode::onBOOT which was called: # once (14µs+12µs) by Archive::Zip::Archive::BEGIN@12 at line 174 sub Encode::onBOOT; # xsub