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