← Index
NYTProf Performance Profile   « block view • line view • sub view »
For /usr/share/koha/opac/cgi-bin/opac/opac-search.pl
  Run on Tue Oct 15 17:10:45 2013
Reported on Tue Oct 15 17:11:32 2013

Filename/usr/lib/perl/5.10/Encode.pm
StatementsExecuted 9918 statements in 22.7ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
546226.94ms23.3msEncode::::decode Encode::decode
546114.31ms5.77msEncode::utf8::::decode_xs Encode::utf8::decode_xs (xsub)
547114.25ms7.14msEncode::::getEncoding Encode::getEncoding (recurses: max depth 1, inclusive time 8µs)
547222.74ms9.88msEncode::::find_encoding Encode::find_encoding (recurses: max depth 1, inclusive time 19µs)
1111.87ms2.85msEncode::::BEGIN@48 Encode::BEGIN@48
1111.45ms1.67msEncode::::BEGIN@13 Encode::BEGIN@13
54411729µs729µsEncode::::LEAVE_SRC Encode::LEAVE_SRC (xsub)
111663µs714µsEncode::::predefine_encodings Encode::predefine_encodings
6733440µs440µsEncode::::is_utf8 Encode::is_utf8 (xsub)
111286µs290µsEncode::utf8::::BEGIN@309 Encode::utf8::BEGIN@309
41170µs70µsEncode::::define_encoding Encode::define_encoding
11129µs39µsEncode::::BEGIN@5 Encode::BEGIN@5
21124µs93µsEncode::::decode_utf8 Encode::decode_utf8
11121µs54µsEncode::::BEGIN@6 Encode::BEGIN@6
11121µs49µsEncode::::BEGIN@226 Encode::BEGIN@226
11111µs11µsEncode::::CORE:match Encode::CORE:match (opcode)
11110µs10µsEncode::::BEGIN@9 Encode::BEGIN@9
0000s0sEncode::Internal::::__ANON__[:269] Encode::Internal::__ANON__[:269]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:244]Encode::UTF_EBCDIC::__ANON__[:244]
0000s0sEncode::UTF_EBCDIC::::__ANON__[:256]Encode::UTF_EBCDIC::__ANON__[:256]
0000s0sEncode::::clone_encoding Encode::clone_encoding
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__[:297] Encode::utf8::__ANON__[:297]
0000s0sEncode::utf8::::__ANON__[:303] Encode::utf8::__ANON__[:303]
0000s0sEncode::utf8::::__ANON__[:319] Encode::utf8::__ANON__[:319]
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.35 2009/07/13 00:49:38 dankogai Exp $
3#
4package Encode;
5348µs248µ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
use strict;
# spent 39µs making 1 call to Encode::BEGIN@5 # spent 9µs making 1 call to strict::import
63115µs287µ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
use warnings;
# spent 54µs making 1 call to Encode::BEGIN@6 # spent 33µs making 1 call to warnings::import
7124µs111µsour $VERSION = sprintf "%d.%02d", q$Revision: 2.35 $ =~ /(\d+)/g;
# spent 11µs making 1 call to Encode::CORE:match
8sub DEBUG () { 0 }
9376µs110µs
# spent 10µs within Encode::BEGIN@9 which was called: # once (10µs+0s) by Cache::Memcached::BEGIN@21 at line 9
use XSLoader ();
# spent 10µs making 1 call to Encode::BEGIN@9
101348µs1452µsXSLoader::load( __PACKAGE__, $VERSION );
# spent 452µs making 1 call to XSLoader::load
11
1212µsrequire Exporter;
133303µs21.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
use base qw/Exporter/;
# 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
1715µsour @EXPORT = qw(
18 decode decode_utf8 encode encode_utf8 str2bytes bytes2str
19 encodings find_encoding clone_encoding
20);
21110µsour @FB_FLAGS = qw(
22 DIE_ON_ERR WARN_ON_ERR RETURN_ON_ERR LEAVE_SRC
23 PERLQQ HTMLCREF XMLCREF STOP_AT_PARTIAL
24);
2513µsour @FB_CONSTS = qw(
26 FB_DEFAULT FB_CROAK FB_QUIET FB_WARN
27 FB_PERLQQ FB_HTMLCREF FB_XMLCREF
28);
29112µ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
37124µ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
4611µsour $ON_EBCDIC = ( ord("A") == 193 );
47
4831.91ms22.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
use Encode::Alias;
# 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
511500nsour %Encoding;
521400nsour %ExtModule;
531229µ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.
57488µseval {
58 local $SIG{__DIE__};
59 local $SIG{__WARN__};
60 require Encode::ConfigLocal;
61};
62
63sub 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
82sub 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
sub define_encoding {
892868µs my $obj = shift;
90 my $name = shift;
91 $Encoding{$name} = $obj;
92 my $lc = lc($name);
93 define_alias( $lc => $obj ) unless $lc eq $name;
94 while (@_) {
95 my $alias = shift;
96 define_alias( $alias, $obj );
97 }
98 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
sub getEncoding {
10238173.92ms my ( $class, $name, $skip_external ) = @_;
103
104 ref($name) && $name->can('renew') and return $name;
105 exists $Encoding{$name} and return $Encoding{$name};
106 my $lc = lc $name;
107 exists $Encoding{$lc} and return $Encoding{$lc};
108
1095442.90ms my $oc = $class->find_alias($name);
# spent 2.90ms making 544 calls to Encode::Alias::find_alias, avg 5µs/call
110 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
sub find_encoding($;$) {
12610942.49ms my ( $name, $skip_external ) = @_;
1275477.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
130sub resolve_alias($) {
131 my $obj = find_encoding(shift);
132 defined $obj and return $obj->name;
133 return;
134}
135
136sub 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
144sub 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}
16215µ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
sub decode($$;$) {
16549149.21ms my ( $name, $octets, $check ) = @_;
166 return undef unless defined $octets;
167 $octets .= '' if ref $octets;
168 $check ||= 0;
1695469.88ms my $enc = find_encoding($name);
# spent 9.88ms making 546 calls to Encode::find_encoding, avg 18µs/call
170 unless ( defined $enc ) {
171 require Carp;
172 Carp::croak("Unknown encoding '$name'");
173 }
17412.44ms10927.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
175544729µ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 return $string;
177}
17811µs*bytes2str = \&decode;
179
180sub 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
200sub 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
sub decode_utf8($;$) {
207617µs my ( $str, $check ) = @_;
20824µs return $str if is_utf8($str);
# spent 4µs making 2 calls to Encode::is_utf8, avg 2µs/call
209210µs if ($check) {
210 return decode( "utf8", $str, $check );
211 }
212 else {
213265µs return decode( "utf8", $str );
# spent 65µs making 2 calls to Encode::decode, avg 32µs/call
214 return $str;
215 }
216}
217
21815µs1714µspredefine_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
sub predefine_encodings {
2254121µs require Encode::Encoding;
2263641µs276µ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
no warnings 'redefine';
# spent 49µs making 1 call to Encode::BEGIN@226 # spent 28µs making 1 call to warnings::unimport
227 my $use_xs = shift;
228423µ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 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 };
270 *encode = \&decode;
271 $Encode::Encoding{Unicode} =
272 bless { Name => "Internal" } => "Encode::Internal";
273 }
274
275 {
276
277 # was in Encode::utf8
278 package Encode::utf8;
279517µs push @Encode::utf8::ISA, 'Encode::Encoding';
280
281 #
28232µs if ($use_xs) {
283 Encode::DEBUG and warn __PACKAGE__, " XS on";
284 *decode = \&decode_xs;
285 *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 ];
3093491µs2295µ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
use bytes;
# 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 };
320 $Encode::Encoding{utf8} =
321 bless { Name => "utf8" } => "Encode::utf8";
322 $Encode::Encoding{"utf-8-strict"} =
323 bless { Name => "utf-8-strict", strict_utf8 => 1 } =>
324 "Encode::utf8";
325 }
326}
327
328124µs1;
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
sub Encode::CORE:match; # opcode
# 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
sub Encode::LEAVE_SRC; # xsub
# 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
sub Encode::is_utf8; # xsub
# 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
sub Encode::utf8::decode_xs; # xsub
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.