Filename | /usr/lib/perl/5.10/Encode.pm |
Statements | Executed 9918 statements in 22.7ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
546 | 2 | 2 | 6.94ms | 23.3ms | decode | Encode::
546 | 1 | 1 | 4.31ms | 5.77ms | decode_xs (xsub) | Encode::utf8::
547 | 1 | 1 | 4.25ms | 7.14ms | getEncoding (recurses: max depth 1, inclusive time 8µs) | Encode::
547 | 2 | 2 | 2.74ms | 9.88ms | find_encoding (recurses: max depth 1, inclusive time 19µs) | Encode::
1 | 1 | 1 | 1.87ms | 2.85ms | BEGIN@48 | Encode::
1 | 1 | 1 | 1.45ms | 1.67ms | BEGIN@13 | Encode::
544 | 1 | 1 | 729µs | 729µs | LEAVE_SRC (xsub) | Encode::
1 | 1 | 1 | 663µs | 714µs | predefine_encodings | Encode::
67 | 3 | 3 | 440µs | 440µs | is_utf8 (xsub) | Encode::
1 | 1 | 1 | 286µs | 290µs | BEGIN@309 | Encode::utf8::
4 | 1 | 1 | 70µs | 70µs | define_encoding | Encode::
1 | 1 | 1 | 29µs | 39µs | BEGIN@5 | Encode::
2 | 1 | 1 | 24µs | 93µs | decode_utf8 | Encode::
1 | 1 | 1 | 21µs | 54µs | BEGIN@6 | Encode::
1 | 1 | 1 | 21µs | 49µs | BEGIN@226 | Encode::
1 | 1 | 1 | 11µs | 11µs | CORE:match (opcode) | Encode::
1 | 1 | 1 | 10µs | 10µs | BEGIN@9 | Encode::
0 | 0 | 0 | 0s | 0s | __ANON__[:269] | Encode::Internal::
0 | 0 | 0 | 0s | 0s | __ANON__[:244] | Encode::UTF_EBCDIC::
0 | 0 | 0 | 0s | 0s | __ANON__[:256] | Encode::UTF_EBCDIC::
0 | 0 | 0 | 0s | 0s | clone_encoding | Encode::
0 | 0 | 0 | 0s | 0s | encode | Encode::
0 | 0 | 0 | 0s | 0s | encode_utf8 | Encode::
0 | 0 | 0 | 0s | 0s | encodings | Encode::
0 | 0 | 0 | 0s | 0s | from_to | Encode::
0 | 0 | 0 | 0s | 0s | perlio_ok | Encode::
0 | 0 | 0 | 0s | 0s | resolve_alias | Encode::
0 | 0 | 0 | 0s | 0s | __ANON__[:297] | Encode::utf8::
0 | 0 | 0 | 0s | 0s | __ANON__[:303] | Encode::utf8::
0 | 0 | 0 | 0s | 0s | __ANON__[:319] | Encode::utf8::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | # | ||||
2 | # $Id: Encode.pm,v 2.35 2009/07/13 00:49:38 dankogai Exp $ | ||||
3 | # | ||||
4 | package Encode; | ||||
5 | 3 | 48µs | 2 | 48µs | # spent 39µs (29+9) within Encode::BEGIN@5 which was called:
# once (29µs+9µs) by Cache::Memcached::BEGIN@21 at line 5 # spent 39µs making 1 call to Encode::BEGIN@5
# spent 9µs making 1 call to strict::import |
6 | 3 | 115µs | 2 | 87µs | # spent 54µs (21+33) within Encode::BEGIN@6 which was called:
# once (21µs+33µs) by Cache::Memcached::BEGIN@21 at line 6 # spent 54µs making 1 call to Encode::BEGIN@6
# spent 33µs making 1 call to warnings::import |
7 | 1 | 24µs | 1 | 11µs | our $VERSION = sprintf "%d.%02d", q$Revision: 2.35 $ =~ /(\d+)/g; # spent 11µs making 1 call to Encode::CORE:match |
8 | sub DEBUG () { 0 } | ||||
9 | 3 | 76µs | 1 | 10µs | # spent 10µs within Encode::BEGIN@9 which was called:
# once (10µs+0s) by Cache::Memcached::BEGIN@21 at line 9 # spent 10µs making 1 call to Encode::BEGIN@9 |
10 | 1 | 348µs | 1 | 452µs | XSLoader::load( __PACKAGE__, $VERSION ); # spent 452µs making 1 call to XSLoader::load |
11 | |||||
12 | 1 | 2µs | require Exporter; | ||
13 | 3 | 303µs | 2 | 1.77ms | # spent 1.67ms (1.45+224µs) within Encode::BEGIN@13 which was called:
# once (1.45ms+224µs) by Cache::Memcached::BEGIN@21 at line 13 # spent 1.67ms making 1 call to Encode::BEGIN@13
# spent 94µs making 1 call to base::import |
14 | |||||
15 | # Public, encouraged API is exported by default | ||||
16 | |||||
17 | 1 | 5µs | our @EXPORT = qw( | ||
18 | decode decode_utf8 encode encode_utf8 str2bytes bytes2str | ||||
19 | encodings find_encoding clone_encoding | ||||
20 | ); | ||||
21 | 1 | 10µs | our @FB_FLAGS = qw( | ||
22 | DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC | ||||
23 | PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL | ||||
24 | ); | ||||
25 | 1 | 3µs | our @FB_CONSTS = qw( | ||
26 | FB_DEFAULT FB_CROAK FB_QUIET FB_WARN | ||||
27 | FB_PERLQQ FB_HTMLCREF FB_XMLCREF | ||||
28 | ); | ||||
29 | 1 | 12µs | our @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 | |||||
37 | 1 | 24µs | our %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 | |||||
46 | 1 | 1µs | our $ON_EBCDIC = ( ord("A") == 193 ); | ||
47 | |||||
48 | 3 | 1.91ms | 2 | 2.94ms | # spent 2.85ms (1.87+987µs) within Encode::BEGIN@48 which was called:
# once (1.87ms+987µs) by Cache::Memcached::BEGIN@21 at line 48 # spent 2.85ms making 1 call to Encode::BEGIN@48
# spent 83µs making 1 call to Exporter::import |
49 | |||||
50 | # Make a %Encoding package variable to allow a certain amount of cheating | ||||
51 | 1 | 500ns | our %Encoding; | ||
52 | 1 | 400ns | our %ExtModule; | ||
53 | 1 | 229µs | require 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. | ||||
57 | 1 | 800ns | eval { | ||
58 | 1 | 12µs | local $SIG{__DIE__}; | ||
59 | 1 | 6µs | local $SIG{__WARN__}; | ||
60 | 1 | 69µs | require Encode::ConfigLocal; | ||
61 | }; | ||||
62 | |||||
63 | sub encodings { | ||||
64 | my $class = shift; | ||||
65 | my %enc; | ||||
66 | if ( @_ and $_[0] eq ":all" ) { | ||||
67 | %enc = ( %Encoding, %ExtModule ); | ||||
68 | } | ||||
69 | else { | ||||
70 | %enc = %Encoding; | ||||
71 | for my $mod ( map { m/::/o ? $_ : "Encode::$_" } @_ ) { | ||||
72 | DEBUG and warn $mod; | ||||
73 | for my $enc ( keys %ExtModule ) { | ||||
74 | $ExtModule{$enc} eq $mod and $enc{$enc} = $mod; | ||||
75 | } | ||||
76 | } | ||||
77 | } | ||||
78 | return sort { lc $a cmp lc $b } | ||||
79 | grep { !/^(?:Internal|Unicode|Guess)$/o } keys %enc; | ||||
80 | } | ||||
81 | |||||
82 | sub perlio_ok { | ||||
83 | my $obj = ref( $_[0] ) ? $_[0] : find_encoding( $_[0] ); | ||||
84 | $obj->can("perlio_ok") and return $obj->perlio_ok(); | ||||
85 | return 0; # safety net | ||||
86 | } | ||||
87 | |||||
88 | # spent 70µs within Encode::define_encoding which was called 4 times, avg 17µs/call:
# 4 times (70µs+0s) by XSLoader::load at line 94 of XSLoader.pm, avg 17µs/call | ||||
89 | 4 | 5µs | my $obj = shift; | ||
90 | 4 | 4µs | my $name = shift; | ||
91 | 4 | 8µs | $Encoding{$name} = $obj; | ||
92 | 4 | 11µs | my $lc = lc($name); | ||
93 | 4 | 4µs | define_alias( $lc => $obj ) unless $lc eq $name; | ||
94 | 4 | 8µs | while (@_) { | ||
95 | my $alias = shift; | ||||
96 | define_alias( $alias, $obj ); | ||||
97 | } | ||||
98 | 4 | 28µs | return $obj; | ||
99 | } | ||||
100 | |||||
101 | # spent 7.14ms (4.25+2.89) within Encode::getEncoding which was called 547 times, avg 13µs/call:
# 547 times (4.25ms+2.89ms) by Encode::find_encoding at line 127, avg 13µs/call | ||||
102 | 547 | 389µs | my ( $class, $name, $skip_external ) = @_; | ||
103 | |||||
104 | 547 | 160µs | ref($name) && $name->can('renew') and return $name; | ||
105 | 547 | 372µs | exists $Encoding{$name} and return $Encoding{$name}; | ||
106 | 544 | 305µs | my $lc = lc $name; | ||
107 | 544 | 158µs | exists $Encoding{$lc} and return $Encoding{$lc}; | ||
108 | |||||
109 | 544 | 1.19ms | 544 | 2.90ms | my $oc = $class->find_alias($name); # spent 2.90ms making 544 calls to Encode::Alias::find_alias, avg 5µs/call |
110 | 544 | 1.35ms | defined($oc) and return $oc; | ||
111 | $lc ne $name and $oc = $class->find_alias($lc); | ||||
112 | defined($oc) and return $oc; | ||||
113 | |||||
114 | unless ($skip_external) { | ||||
115 | if ( my $mod = $ExtModule{$name} || $ExtModule{$lc} ) { | ||||
116 | $mod =~ s,::,/,g; | ||||
117 | $mod .= '.pm'; | ||||
118 | eval { require $mod; }; | ||||
119 | exists $Encoding{$name} and return $Encoding{$name}; | ||||
120 | } | ||||
121 | } | ||||
122 | return; | ||||
123 | } | ||||
124 | |||||
125 | # spent 9.88ms (2.74+7.13) within Encode::find_encoding which was called 547 times, avg 18µs/call:
# 546 times (2.73ms+7.14ms) by Encode::decode at line 169, avg 18µs/call
# once (12µs+-12µs) by Encode::Alias::find_alias at line 46 of Encode/Alias.pm | ||||
126 | 547 | 330µs | my ( $name, $skip_external ) = @_; | ||
127 | 547 | 2.16ms | 547 | 7.14ms | return __PACKAGE__->getEncoding( $name, $skip_external ); # spent 7.15ms making 547 calls to Encode::getEncoding, avg 13µs/call, recursion: max depth 1, sum of overlapping time 8µs |
128 | } | ||||
129 | |||||
130 | sub resolve_alias($) { | ||||
131 | my $obj = find_encoding(shift); | ||||
132 | defined $obj and return $obj->name; | ||||
133 | return; | ||||
134 | } | ||||
135 | |||||
136 | sub clone_encoding($) { | ||||
137 | my $obj = find_encoding(shift); | ||||
138 | ref $obj or return; | ||||
139 | eval { require Storable }; | ||||
140 | $@ and return; | ||||
141 | return Storable::dclone($obj); | ||||
142 | } | ||||
143 | |||||
144 | sub encode($$;$) { | ||||
145 | my ( $name, $string, $check ) = @_; | ||||
146 | return undef unless defined $string; | ||||
147 | $string .= '' if ref $string; # stringify; | ||||
148 | $check ||= 0; | ||||
149 | unless ( defined $name ) { | ||||
150 | require Carp; | ||||
151 | Carp::croak("Encoding name should not be undef"); | ||||
152 | } | ||||
153 | my $enc = find_encoding($name); | ||||
154 | unless ( defined $enc ) { | ||||
155 | require Carp; | ||||
156 | Carp::croak("Unknown encoding '$name'"); | ||||
157 | } | ||||
158 | my $octets = $enc->encode( $string, $check ); | ||||
159 | $_[1] = $string if $check and !ref $check and !( $check & LEAVE_SRC() ); | ||||
160 | return $octets; | ||||
161 | } | ||||
162 | 1 | 5µs | *str2bytes = \&encode; | ||
163 | |||||
164 | # spent 23.3ms (6.94+16.4) within Encode::decode which was called 546 times, avg 43µs/call:
# 544 times (6.92ms+16.3ms) by MARC::File::Encode::marc_to_utf8 at line 35 of MARC/File/Encode.pm, avg 43µs/call
# 2 times (22µs+43µs) by Encode::decode_utf8 at line 213, avg 32µs/call | ||||
165 | 546 | 522µs | my ( $name, $octets, $check ) = @_; | ||
166 | 546 | 143µs | return undef unless defined $octets; | ||
167 | 546 | 182µs | $octets .= '' if ref $octets; | ||
168 | 546 | 127µs | $check ||= 0; | ||
169 | 546 | 1.15ms | 546 | 9.88ms | my $enc = find_encoding($name); # spent 9.88ms making 546 calls to Encode::find_encoding, avg 18µs/call |
170 | 546 | 130µs | unless ( defined $enc ) { | ||
171 | require Carp; | ||||
172 | Carp::croak("Unknown encoding '$name'"); | ||||
173 | } | ||||
174 | 546 | 5.35ms | 1092 | 7.23ms | my $string = $enc->decode( $octets, $check ); # spent 5.77ms making 546 calls to Encode::utf8::decode_xs, avg 11µs/call
# spent 1.46ms making 546 calls to Encode::Encoding::renewed, avg 3µs/call |
175 | 546 | 2.40ms | 544 | 729µs | $_[1] = $octets if $check and !ref $check and !( $check & LEAVE_SRC() ); # spent 729µs making 544 calls to Encode::LEAVE_SRC, avg 1µs/call |
176 | 546 | 1.64ms | return $string; | ||
177 | } | ||||
178 | 1 | 1µs | *bytes2str = \&decode; | ||
179 | |||||
180 | sub from_to($$$;$) { | ||||
181 | my ( $string, $from, $to, $check ) = @_; | ||||
182 | return undef unless defined $string; | ||||
183 | $check ||= 0; | ||||
184 | my $f = find_encoding($from); | ||||
185 | unless ( defined $f ) { | ||||
186 | require Carp; | ||||
187 | Carp::croak("Unknown encoding '$from'"); | ||||
188 | } | ||||
189 | my $t = find_encoding($to); | ||||
190 | unless ( defined $t ) { | ||||
191 | require Carp; | ||||
192 | Carp::croak("Unknown encoding '$to'"); | ||||
193 | } | ||||
194 | my $uni = $f->decode($string); | ||||
195 | $_[0] = $string = $t->encode( $uni, $check ); | ||||
196 | return undef if ( $check && length($uni) ); | ||||
197 | return defined( $_[0] ) ? length($string) : undef; | ||||
198 | } | ||||
199 | |||||
200 | sub encode_utf8($) { | ||||
201 | my ($str) = @_; | ||||
202 | utf8::encode($str); | ||||
203 | return $str; | ||||
204 | } | ||||
205 | |||||
206 | # spent 93µs (24+69) within Encode::decode_utf8 which was called 2 times, avg 47µs/call:
# 2 times (24µs+69µs) by main::RUNTIME at line 637 of /usr/share/koha/opac/cgi-bin/opac/opac-search.pl, avg 47µs/call | ||||
207 | 2 | 2µs | my ( $str, $check ) = @_; | ||
208 | 2 | 14µs | 2 | 4µs | return $str if is_utf8($str); # spent 4µs making 2 calls to Encode::is_utf8, avg 2µs/call |
209 | 2 | 700ns | if ($check) { | ||
210 | return decode( "utf8", $str, $check ); | ||||
211 | } | ||||
212 | else { | ||||
213 | 2 | 10µs | 2 | 65µs | return decode( "utf8", $str ); # spent 65µs making 2 calls to Encode::decode, avg 32µs/call |
214 | return $str; | ||||
215 | } | ||||
216 | } | ||||
217 | |||||
218 | 1 | 5µs | 1 | 714µs | predefine_encodings(1); # spent 714µs making 1 call to Encode::predefine_encodings |
219 | |||||
220 | # | ||||
221 | # This is to restore %Encoding if really needed; | ||||
222 | # | ||||
223 | |||||
224 | # spent 714µs (663+52) within Encode::predefine_encodings which was called:
# once (663µs+52µs) by Cache::Memcached::BEGIN@21 at line 218 | ||||
225 | 1 | 114µs | require Encode::Encoding; | ||
226 | 3 | 641µs | 2 | 76µs | # spent 49µs (21+28) within Encode::BEGIN@226 which was called:
# once (21µs+28µs) by Cache::Memcached::BEGIN@21 at line 226 # spent 49µs making 1 call to Encode::BEGIN@226
# spent 28µs making 1 call to warnings::unimport |
227 | 1 | 900ns | my $use_xs = shift; | ||
228 | 1 | 1µs | if ($ON_EBCDIC) { | ||
229 | |||||
230 | # was in Encode::UTF_EBCDIC | ||||
231 | package Encode::UTF_EBCDIC; | ||||
232 | push @Encode::UTF_EBCDIC::ISA, 'Encode::Encoding'; | ||||
233 | *decode = sub { | ||||
234 | my ( $obj, $str, $chk ) = @_; | ||||
235 | my $res = ''; | ||||
236 | for ( my $i = 0 ; $i < length($str) ; $i++ ) { | ||||
237 | $res .= | ||||
238 | chr( | ||||
239 | utf8::unicode_to_native( ord( substr( $str, $i, 1 ) ) ) | ||||
240 | ); | ||||
241 | } | ||||
242 | $_[1] = '' if $chk; | ||||
243 | return $res; | ||||
244 | }; | ||||
245 | *encode = sub { | ||||
246 | my ( $obj, $str, $chk ) = @_; | ||||
247 | my $res = ''; | ||||
248 | for ( my $i = 0 ; $i < length($str) ; $i++ ) { | ||||
249 | $res .= | ||||
250 | chr( | ||||
251 | utf8::native_to_unicode( ord( substr( $str, $i, 1 ) ) ) | ||||
252 | ); | ||||
253 | } | ||||
254 | $_[1] = '' if $chk; | ||||
255 | return $res; | ||||
256 | }; | ||||
257 | $Encode::Encoding{Unicode} = | ||||
258 | bless { Name => "UTF_EBCDIC" } => "Encode::UTF_EBCDIC"; | ||||
259 | } | ||||
260 | else { | ||||
261 | |||||
262 | package Encode::Internal; | ||||
263 | 1 | 9µs | push @Encode::Internal::ISA, 'Encode::Encoding'; | ||
264 | *decode = sub { | ||||
265 | my ( $obj, $str, $chk ) = @_; | ||||
266 | utf8::upgrade($str); | ||||
267 | $_[1] = '' if $chk; | ||||
268 | return $str; | ||||
269 | 1 | 4µs | }; | ||
270 | 1 | 800ns | *encode = \&decode; | ||
271 | 1 | 10µs | $Encode::Encoding{Unicode} = | ||
272 | bless { Name => "Internal" } => "Encode::Internal"; | ||||
273 | } | ||||
274 | |||||
275 | { | ||||
276 | |||||
277 | # was in Encode::utf8 | ||||
278 | 1 | 5µs | package Encode::utf8; | ||
279 | 1 | 4µs | push @Encode::utf8::ISA, 'Encode::Encoding'; | ||
280 | |||||
281 | # | ||||
282 | 1 | 700ns | if ($use_xs) { | ||
283 | 1 | 200ns | Encode::DEBUG and warn __PACKAGE__, " XS on"; | ||
284 | 1 | 1µs | *decode = \&decode_xs; | ||
285 | 1 | 700ns | *encode = \&encode_xs; | ||
286 | } | ||||
287 | else { | ||||
288 | Encode::DEBUG and warn __PACKAGE__, " XS off"; | ||||
289 | *decode = sub { | ||||
290 | my ( $obj, $octets, $chk ) = @_; | ||||
291 | my $str = Encode::decode_utf8($octets); | ||||
292 | if ( defined $str ) { | ||||
293 | $_[1] = '' if $chk; | ||||
294 | return $str; | ||||
295 | } | ||||
296 | return undef; | ||||
297 | }; | ||||
298 | *encode = sub { | ||||
299 | my ( $obj, $string, $chk ) = @_; | ||||
300 | my $octets = Encode::encode_utf8($string); | ||||
301 | $_[1] = '' if $chk; | ||||
302 | return $octets; | ||||
303 | }; | ||||
304 | } | ||||
305 | *cat_decode = sub { # ($obj, $dst, $src, $pos, $trm, $chk) | ||||
306 | # currently ignores $chk | ||||
307 | my ( $obj, undef, undef, $pos, $trm ) = @_; | ||||
308 | my ( $rdst, $rsrc, $rpos ) = \@_[ 1, 2, 3 ]; | ||||
309 | 3 | 491µs | 2 | 295µs | # spent 290µs (286+5) within Encode::utf8::BEGIN@309 which was called:
# once (286µs+5µs) by Cache::Memcached::BEGIN@21 at line 309 # spent 290µs making 1 call to Encode::utf8::BEGIN@309
# spent 5µs making 1 call to bytes::import |
310 | if ( ( my $npos = index( $$rsrc, $trm, $pos ) ) >= 0 ) { | ||||
311 | $$rdst .= | ||||
312 | substr( $$rsrc, $pos, $npos - $pos + length($trm) ); | ||||
313 | $$rpos = $npos + length($trm); | ||||
314 | return 1; | ||||
315 | } | ||||
316 | $$rdst .= substr( $$rsrc, $pos ); | ||||
317 | $$rpos = length($$rsrc); | ||||
318 | return ''; | ||||
319 | 1 | 4µs | }; | ||
320 | 1 | 6µs | $Encode::Encoding{utf8} = | ||
321 | bless { Name => "utf8" } => "Encode::utf8"; | ||||
322 | 1 | 3µs | $Encode::Encoding{"utf-8-strict"} = | ||
323 | bless { Name => "utf-8-strict", strict_utf8 => 1 } => | ||||
324 | "Encode::utf8"; | ||||
325 | } | ||||
326 | } | ||||
327 | |||||
328 | 1 | 24µs | 1; | ||
329 | |||||
330 | __END__ | ||||
# spent 11µs within Encode::CORE:match which was called:
# once (11µs+0s) by Cache::Memcached::BEGIN@21 at line 7 | |||||
# spent 729µs within Encode::LEAVE_SRC which was called 544 times, avg 1µs/call:
# 544 times (729µs+0s) by Encode::decode at line 175, avg 1µs/call | |||||
# spent 440µs within Encode::is_utf8 which was called 67 times, avg 7µs/call:
# 57 times (389µs+0s) by Cache::Memcached::get at line 580 of Cache/Memcached.pm, avg 7µs/call
# 8 times (46µs+0s) by Template::Provider::_decode_unicode at line 1092 of Template/Provider.pm, avg 6µs/call
# 2 times (4µs+0s) by Encode::decode_utf8 at line 208, avg 2µs/call | |||||
# spent 5.77ms (4.31+1.46) within Encode::utf8::decode_xs which was called 546 times, avg 11µs/call:
# 546 times (4.31ms+1.46ms) by Encode::decode at line 174, avg 11µs/call |