← 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:12:24 2013

Filename/usr/share/perl/5.10/CGI/Util.pm
StatementsExecuted 688 statements in 4.36ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
2211720µs771µsCGI::Util::::_rearrange_paramsCGI::Util::_rearrange_params
1042399µs554µsCGI::Util::::escapeCGI::Util::escape
2266321µs1.36msCGI::Util::::rearrangeCGI::Util::rearrange
411127µs138µsCGI::Util::::simple_escapeCGI::Util::simple_escape
111121µs265µsCGI::Util::::make_attributesCGI::Util::make_attributes
3011115µs115µsCGI::Util::::CORE:substcontCGI::Util::CORE:substcont (opcode)
639197µs97µsCGI::Util::::CORE:substCGI::Util::CORE:subst (opcode)
64360µs64µsCGI::Util::::unescapeCGI::Util::unescape
11159µs116µsCGI::Util::::expiresCGI::Util::expires
11151µs51µsCGI::Util::::expire_calcCGI::Util::expire_calc
11118µs22µsCGI::Util::::BEGIN@3CGI::Util::BEGIN@3
1119µs188µsCGI::Util::::BEGIN@4CGI::Util::BEGIN@4
1117µs7µsCGI::Util::::CORE:matchCGI::Util::CORE:match (opcode)
0000s0sCGI::Util::::ascii2ebcdicCGI::Util::ascii2ebcdic
0000s0sCGI::Util::::ebcdic2asciiCGI::Util::ebcdic2ascii
0000s0sCGI::Util::::rearrange_headerCGI::Util::rearrange_header
0000s0sCGI::Util::::utf8_chrCGI::Util::utf8_chr
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package CGI::Util;
2
3336µs226µs
# spent 22µs (18+4) within CGI::Util::BEGIN@3 which was called: # once (18µs+4µs) by CGI::BEGIN@27 at line 3
use strict;
# spent 22µs making 1 call to CGI::Util::BEGIN@3 # spent 4µs making 1 call to strict::import
432.09ms2367µs
# spent 188µs (9+179) within CGI::Util::BEGIN@4 which was called: # once (9µs+179µs) by CGI::BEGIN@27 at line 4
use vars qw($VERSION @EXPORT_OK @ISA $EBCDIC @A2E @E2A);
# spent 188µs making 1 call to CGI::Util::BEGIN@4 # spent 179µs making 1 call to vars::import
511µsrequire Exporter;
6113µs@ISA = qw(Exporter);
712µs@EXPORT_OK = qw(rearrange rearrange_header make_attributes unescape escape
8 expires ebcdic2ascii ascii2ebcdic);
9
101400ns$VERSION = '1.5_01';
11
121400ns$EBCDIC = "\t" ne "\011";
13# (ord('^') == 95) for codepage 1047 as on os390, vmesa
14116µs@A2E = (
15 0, 1, 2, 3, 55, 45, 46, 47, 22, 5, 21, 11, 12, 13, 14, 15,
16 16, 17, 18, 19, 60, 61, 50, 38, 24, 25, 63, 39, 28, 29, 30, 31,
17 64, 90,127,123, 91,108, 80,125, 77, 93, 92, 78,107, 96, 75, 97,
18 240,241,242,243,244,245,246,247,248,249,122, 94, 76,126,110,111,
19 124,193,194,195,196,197,198,199,200,201,209,210,211,212,213,214,
20 215,216,217,226,227,228,229,230,231,232,233,173,224,189, 95,109,
21 121,129,130,131,132,133,134,135,136,137,145,146,147,148,149,150,
22 151,152,153,162,163,164,165,166,167,168,169,192, 79,208,161, 7,
23 32, 33, 34, 35, 36, 37, 6, 23, 40, 41, 42, 43, 44, 9, 10, 27,
24 48, 49, 26, 51, 52, 53, 54, 8, 56, 57, 58, 59, 4, 20, 62,255,
25 65,170, 74,177,159,178,106,181,187,180,154,138,176,202,175,188,
26 144,143,234,250,190,160,182,179,157,218,155,139,183,184,185,171,
27 100,101, 98,102, 99,103,158,104,116,113,114,115,120,117,118,119,
28 172,105,237,238,235,239,236,191,128,253,254,251,252,186,174, 89,
29 68, 69, 66, 70, 67, 71,156, 72, 84, 81, 82, 83, 88, 85, 86, 87,
30 140, 73,205,206,203,207,204,225,112,221,222,219,220,141,142,223
31 );
32113µs@E2A = (
33 0, 1, 2, 3,156, 9,134,127,151,141,142, 11, 12, 13, 14, 15,
34 16, 17, 18, 19,157, 10, 8,135, 24, 25,146,143, 28, 29, 30, 31,
35 128,129,130,131,132,133, 23, 27,136,137,138,139,140, 5, 6, 7,
36 144,145, 22,147,148,149,150, 4,152,153,154,155, 20, 21,158, 26,
37 32,160,226,228,224,225,227,229,231,241,162, 46, 60, 40, 43,124,
38 38,233,234,235,232,237,238,239,236,223, 33, 36, 42, 41, 59, 94,
39 45, 47,194,196,192,193,195,197,199,209,166, 44, 37, 95, 62, 63,
40 248,201,202,203,200,205,206,207,204, 96, 58, 35, 64, 39, 61, 34,
41 216, 97, 98, 99,100,101,102,103,104,105,171,187,240,253,254,177,
42 176,106,107,108,109,110,111,112,113,114,170,186,230,184,198,164,
43 181,126,115,116,117,118,119,120,121,122,161,191,208, 91,222,174,
44 172,163,165,183,169,167,182,188,189,190,221,168,175, 93,180,215,
45 123, 65, 66, 67, 68, 69, 70, 71, 72, 73,173,244,246,242,243,245,
46 125, 74, 75, 76, 77, 78, 79, 80, 81, 82,185,251,252,249,250,255,
47 92,247, 83, 84, 85, 86, 87, 88, 89, 90,178,212,214,210,211,213,
48 48, 49, 50, 51, 52, 53, 54, 55, 56, 57,179,219,220,217,218,159
49 );
50
511600nsif ($EBCDIC && ord('^') == 106) { # as in the BS2000 posix-bc coded character set
52 $A2E[91] = 187; $A2E[92] = 188; $A2E[94] = 106; $A2E[96] = 74;
53 $A2E[123] = 251; $A2E[125] = 253; $A2E[126] = 255; $A2E[159] = 95;
54 $A2E[162] = 176; $A2E[166] = 208; $A2E[168] = 121; $A2E[172] = 186;
55 $A2E[175] = 161; $A2E[217] = 224; $A2E[219] = 221; $A2E[221] = 173;
56 $A2E[249] = 192;
57
58 $E2A[74] = 96; $E2A[95] = 159; $E2A[106] = 94; $E2A[121] = 168;
59 $E2A[161] = 175; $E2A[173] = 221; $E2A[176] = 162; $E2A[186] = 172;
60 $E2A[187] = 91; $E2A[188] = 92; $E2A[192] = 249; $E2A[208] = 166;
61 $E2A[221] = 219; $E2A[224] = 217; $E2A[251] = 123; $E2A[253] = 125;
62 $E2A[255] = 126;
63 }
64elsif ($EBCDIC && ord('^') == 176) { # as in codepage 037 on os400
65 $A2E[10] = 37; $A2E[91] = 186; $A2E[93] = 187; $A2E[94] = 176;
66 $A2E[133] = 21; $A2E[168] = 189; $A2E[172] = 95; $A2E[221] = 173;
67
68 $E2A[21] = 133; $E2A[37] = 10; $E2A[95] = 172; $E2A[173] = 221;
69 $E2A[176] = 94; $E2A[186] = 91; $E2A[187] = 93; $E2A[189] = 168;
70}
71
72# Smart rearrangement of parameters to allow named parameter
73# calling. We do the rearrangement if:
74# the first parameter begins with a -
75
76
# spent 1.36ms (321µs+1.04) within CGI::Util::rearrange which was called 22 times, avg 62µs/call: # 13 times (197µs+231µs) by CGI::cookie at line 3 of (eval 1049)[CGI.pm:869], avg 33µs/call # 2 times (38µs+156µs) by CGI::param at line 430 of CGI.pm, avg 97µs/call # 2 times (17µs+91µs) by CGI::url at line 3 of (eval 1127)[CGI.pm:869], avg 54µs/call # 2 times (16µs+82µs) by CGI::Cookie::new at line 119 of CGI/Cookie.pm, avg 49µs/call # 2 times (19µs+12µs) by CGI::delete at line 6 of (eval 1048)[CGI.pm:869], avg 16µs/call # once (34µs+463µs) by CGI::header at line 7 of (eval 1149)[CGI.pm:869]
sub rearrange {
772237µs my ($order,@param) = @_;
782277µs22771µs my ($result, $leftover) = _rearrange_params( $order, @param );
# spent 771µs making 22 calls to CGI::Util::_rearrange_params, avg 35µs/call
792248µs1265µs push @$result, make_attributes( $leftover, defined $CGI::Q ? $CGI::Q->{escape} : 1 )
# spent 265µs making 1 call to CGI::Util::make_attributes
80 if keys %$leftover;
8122143µs @$result;
82}
83
84sub rearrange_header {
85 my ($order,@param) = @_;
86
87 my ($result,$leftover) = _rearrange_params( $order, @param );
88 push @$result, make_attributes( $leftover, 0, 1 ) if keys %$leftover;
89
90 @$result;
91}
92
93
# spent 771µs (720+51) within CGI::Util::_rearrange_params which was called 22 times, avg 35µs/call: # 22 times (720µs+51µs) by CGI::Util::rearrange at line 78, avg 35µs/call
sub _rearrange_params {
942238µs my($order,@param) = @_;
952217µs return [] unless @param;
96
972239µs if (ref($param[0]) eq 'HASH') {
98 @param = %{$param[0]};
99 } else {
100 return \@param
10121108µs unless (defined($param[0]) && substr($param[0],0,1) eq '-');
102 }
103
104 # map parameters into positional indices
10596µs my ($i,%pos);
10694µs $i = 0;
107916µs foreach (@$order) {
108125197µs foreach (ref($_) eq 'ARRAY' ? @$_ : $_) { $pos{lc($_)} = $i; }
1095531µs $i++;
110 }
111
11296µs my (@result,%leftover);
113939µs $#result = $#$order; # preextend
114912µs while (@param) {
1152524µs my $key = lc(shift(@param));
11625138µs2551µs $key =~ s/^\-//;
# spent 51µs making 25 calls to CGI::Util::CORE:subst, avg 2µs/call
1172567µs if (exists $pos{$key}) {
118 $result[$pos{$key}] = shift(@param);
119 } else {
120411µs $leftover{$key} = shift(@param);
121 }
122 }
123
124950µs return \@result, \%leftover;
125}
126
127
# spent 265µs (121+144) within CGI::Util::make_attributes which was called: # once (121µs+144µs) by CGI::Util::rearrange at line 79
sub make_attributes {
12811µs my $attr = shift;
12913µs return () unless $attr && ref($attr) && ref($attr) eq 'HASH';
13011µs my $escape = shift || 0;
1311900ns my $do_not_quote = shift;
132
13312µs my $quote = $do_not_quote ? '' : '"';
134
13511µs my(@att);
13614µs foreach (keys %{$attr}) {
13744µs my($key) = $_;
138423µs46µs $key=~s/^\-//; # get rid of initial - if present
# spent 6µs making 4 calls to CGI::Util::CORE:subst, avg 1µs/call
139
140 # old way: breaks EBCDIC!
141 # $key=~tr/A-Z_/a-z-/; # parameters are lower case, use dashes
142
14347µs ($key="\L$key") =~ tr/_/-/; # parameters are lower case, use dashes
144
145416µs4138µs my $value = $escape ? simple_escape($attr->{$_}) : $attr->{$_};
# spent 138µs making 4 calls to CGI::Util::simple_escape, avg 34µs/call
146456µs push(@att,defined($attr->{$_}) ? qq/$key=$quote$value$quote/ : qq/$key/);
147 }
14818µs return @att;
149}
150
151
# spent 138µs (127+11) within CGI::Util::simple_escape which was called 4 times, avg 34µs/call: # 4 times (127µs+11µs) by CGI::Util::make_attributes at line 145, avg 34µs/call
sub simple_escape {
15244µs return unless defined(my $toencode = shift);
153479µs44µs $toencode =~ s{&}{&}gso;
# spent 4µs making 4 calls to CGI::Util::CORE:subst, avg 900ns/call
154416µs42µs $toencode =~ s{<}{&lt;}gso;
# spent 2µs making 4 calls to CGI::Util::CORE:subst, avg 625ns/call
155413µs42µs $toencode =~ s{>}{&gt;}gso;
# spent 2µs making 4 calls to CGI::Util::CORE:subst, avg 625ns/call
156412µs42µs $toencode =~ s{\"}{&quot;}gso;
# spent 2µs making 4 calls to CGI::Util::CORE:subst, avg 575ns/call
157# Doesn't work. Can't work. forget it.
158# $toencode =~ s{\x8b}{&#139;}gso;
159# $toencode =~ s{\x9b}{&#155;}gso;
160417µs $toencode;
161}
162
163sub utf8_chr {
164 my $c = shift(@_);
165 if ($] >= 5.006){
166 require utf8;
167 my $u = chr($c);
168 utf8::encode($u); # drop utf8 flag
169 return $u;
170 }
171 if ($c < 0x80) {
172 return sprintf("%c", $c);
173 } elsif ($c < 0x800) {
174 return sprintf("%c%c", 0xc0 | ($c >> 6), 0x80 | ($c & 0x3f));
175 } elsif ($c < 0x10000) {
176 return sprintf("%c%c%c",
177 0xe0 | ($c >> 12),
178 0x80 | (($c >> 6) & 0x3f),
179 0x80 | ( $c & 0x3f));
180 } elsif ($c < 0x200000) {
181 return sprintf("%c%c%c%c",
182 0xf0 | ($c >> 18),
183 0x80 | (($c >> 12) & 0x3f),
184 0x80 | (($c >> 6) & 0x3f),
185 0x80 | ( $c & 0x3f));
186 } elsif ($c < 0x4000000) {
187 return sprintf("%c%c%c%c%c",
188 0xf8 | ($c >> 24),
189 0x80 | (($c >> 18) & 0x3f),
190 0x80 | (($c >> 12) & 0x3f),
191 0x80 | (($c >> 6) & 0x3f),
192 0x80 | ( $c & 0x3f));
193
194 } elsif ($c < 0x80000000) {
195 return sprintf("%c%c%c%c%c%c",
196 0xfc | ($c >> 30),
197 0x80 | (($c >> 24) & 0x3f),
198 0x80 | (($c >> 18) & 0x3f),
199 0x80 | (($c >> 12) & 0x3f),
200 0x80 | (($c >> 6) & 0x3f),
201 0x80 | ( $c & 0x3f));
202 } else {
203 return utf8_chr(0xfffd);
204 }
205}
206
207# unescape URL-encoded data
208
# spent 64µs (60+4) within CGI::Util::unescape which was called 6 times, avg 11µs/call: # 2 times (22µs+2µs) by CGI::_name_and_path_from_env at line 8 of (eval 1129)[CGI.pm:869], avg 12µs/call # 2 times (9µs+0s) by CGI::url at line 11 of (eval 1127)[CGI.pm:869], avg 5µs/call # once (22µs+1µs) by CGI::parse_params at line 773 of CGI.pm # once (7µs+500ns) by CGI::parse_params at line 774 of CGI.pm
sub unescape {
20969µs shift() if @_ > 0 and (ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
21064µs my $todecode = shift;
211612µs return undef unless defined($todecode);
21243µs $todecode =~ tr/+/ /; # pluses become spaces
21343µs if ($EBCDIC) {
214 $todecode =~ s/%([0-9a-fA-F]{2})/chr $A2E[hex($1)]/ge;
215 } else {
216 # handle surrogate pairs first -- dankogai
217418µs42µs $todecode =~ s{
# spent 2µs making 4 calls to CGI::Util::CORE:subst, avg 575ns/call
218 %u([Dd][89a-bA-B][0-9a-fA-F]{2}) # hi
219 %u([Dd][c-fC-F][0-9a-fA-F]{2}) # lo
220 }{
221 utf8_chr(
222 0x10000
223 + (hex($1) - 0xD800) * 0x400
224 + (hex($2) - 0xDC00)
225 )
226 }gex;
22749µs41µs $todecode =~ s/%(?:([0-9a-fA-F]{2})|u([0-9a-fA-F]{4}))/
# spent 1µs making 4 calls to CGI::Util::CORE:subst, avg 350ns/call
228 defined($1)? chr hex($1) : utf8_chr(hex($2))/ge;
229 }
230414µs return $todecode;
231}
232
233# URL-encode data
234#
235# We cannot use the %u escapes, they were rejected by W3C, so the official
236# way is %XX-escaped utf-8 encoding.
237# Naturally, Unicode strings have to be converted to their utf-8 byte
238# representation. (No action is required on 5.6.)
239# Byte strings were traditionally used directly as a sequence of octets.
240# This worked if they actually represented binary data (i.e. in CGI::Compress).
241# This also worked if these byte strings were actually utf-8 encoded; e.g.,
242# when the source file used utf-8 without the apropriate "use utf8;".
243# This fails if the byte string is actually a Latin 1 encoded string, but it
244# was always so and cannot be fixed without breaking the binary data case.
245# -- Stepan Kasal <skasal@redhat.com>
246#
247
# spent 554µs (399+155) within CGI::Util::escape which was called 10 times, avg 55µs/call: # 3 times (299µs+127µs) by CGI::Cookie::as_string at line 168 of CGI/Cookie.pm, avg 142µs/call # 3 times (66µs+18µs) by CGI::Cookie::as_string at line 167 of CGI/Cookie.pm, avg 28µs/call # 2 times (20µs+6µs) by CGI::query_string at line 5 of (eval 1132)[CGI.pm:869], avg 13µs/call # 2 times (13µs+3µs) by CGI::query_string at line 7 of (eval 1132)[CGI.pm:869], avg 8µs/call
sub escape {
248109µs shift() if @_ > 1 and ( ref($_[0]) || (defined $_[1] && $_[0] eq $CGI::DefaultClass));
24910134µs my $toencode = shift;
250103µs return undef unless defined($toencode);
2511056µs1015µs utf8::encode($toencode) if ($] > 5.007 && utf8::is_utf8($toencode));
# spent 15µs making 10 calls to utf8::is_utf8, avg 1µs/call
2521011µs if ($EBCDIC) {
253 $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",$E2A[ord($1)])/eg;
254 } else {
25510307µs40140µs $toencode=~s/([^a-zA-Z0-9_.~-])/uc sprintf("%%%02x",ord($1))/eg;
# spent 115µs making 30 calls to CGI::Util::CORE:substcont, avg 4µs/call # spent 26µs making 10 calls to CGI::Util::CORE:subst, avg 3µs/call
256 }
2571042µs return $toencode;
258}
259
260# This internal routine creates date strings suitable for use in
261# cookies and HTTP headers. (They differ, unfortunately.)
262# Thanks to Mark Fisher for this.
263
# spent 116µs (59+58) within CGI::Util::expires which was called: # once (59µs+58µs) by CGI::header at line 79 of (eval 1149)[CGI.pm:869]
sub expires {
26412µs my($time,$format) = @_;
2651900ns $format ||= 'http';
266
26715µs my(@MON)=qw/Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec/;
26815µs my(@WDAY) = qw/Sun Mon Tue Wed Thu Fri Sat/;
269
270 # pass through preformatted dates for the sake of expire_calc()
27116µs151µs $time = expire_calc($time);
# spent 51µs making 1 call to CGI::Util::expire_calc
272117µs17µs return $time unless $time =~ /^\d+$/;
# spent 7µs making 1 call to CGI::Util::CORE:match
273
274 # make HTTP/cookie date string from GMT'ed time
275 # (cookies use '-' as date separator, HTTP uses ' ')
27612µs my($sc) = ' ';
27711µs $sc = '-' if $format eq "cookie";
27817µs my($sec,$min,$hour,$mday,$mon,$year,$wday) = gmtime($time);
2791800ns $year += 1900;
280121µs return sprintf("%s, %02d$sc%s$sc%04d %02d:%02d:%02d GMT",
281 $WDAY[$wday],$mday,$MON[$mon],$year,$hour,$min,$sec);
282}
283
284# This internal routine creates an expires time exactly some number of
285# hours from the current time. It incorporates modifications from
286# Mark Fisher.
287
# spent 51µs within CGI::Util::expire_calc which was called: # once (51µs+0s) by CGI::Util::expires at line 271
sub expire_calc {
28811µs my($time) = @_;
28919µs my(%mult) = ('s'=>1,
290 'm'=>60,
291 'h'=>60*60,
292 'd'=>60*60*24,
293 'M'=>60*60*24*30,
294 'y'=>60*60*24*365);
295 # format for time can be in any of the forms...
296 # "now" -- expire immediately
297 # "+180s" -- in 180 seconds
298 # "+2m" -- in 2 minutes
299 # "+12h" -- in 12 hours
300 # "+1d" -- in 1 day
301 # "+3M" -- in 3 months
302 # "+2y" -- in 2 years
303 # "-3m" -- 3 minutes ago(!)
304 # If you don't supply one of these forms, we assume you are
305 # specifying the date yourself
30611µs my($offset);
307130µs if (!$time || (lc($time) eq 'now')) {
308 $offset = 0;
309 } elsif ($time=~/^\d+/) {
310 return $time;
311 } elsif ($time=~/^([+-]?(?:\d+|\d*\.\d*))([smhdMy])/) {
312 $offset = ($mult{$2} || 1)*$1;
313 } else {
314 return $time;
315 }
316114µs return (time+$offset);
317}
318
319sub ebcdic2ascii {
320 my $data = shift;
321 $data =~ s/(.)/chr $E2A[ord($1)]/ge;
322 $data;
323}
324
325sub ascii2ebcdic {
326 my $data = shift;
327 $data =~ s/(.)/chr $A2E[ord($1)]/ge;
328 $data;
329}
330
331158µs1;
332
333__END__
 
# spent 7µs within CGI::Util::CORE:match which was called: # once (7µs+0s) by CGI::Util::expires at line 272
sub CGI::Util::CORE:match; # opcode
# spent 97µs within CGI::Util::CORE:subst which was called 63 times, avg 2µs/call: # 25 times (51µs+0s) by CGI::Util::_rearrange_params at line 116, avg 2µs/call # 10 times (26µs+0s) by CGI::Util::escape at line 255, avg 3µs/call # 4 times (6µs+0s) by CGI::Util::make_attributes at line 138, avg 1µs/call # 4 times (4µs+0s) by CGI::Util::simple_escape at line 153, avg 900ns/call # 4 times (2µs+0s) by CGI::Util::simple_escape at line 154, avg 625ns/call # 4 times (2µs+0s) by CGI::Util::simple_escape at line 155, avg 625ns/call # 4 times (2µs+0s) by CGI::Util::unescape at line 217, avg 575ns/call # 4 times (2µs+0s) by CGI::Util::simple_escape at line 156, avg 575ns/call # 4 times (1µs+0s) by CGI::Util::unescape at line 227, avg 350ns/call
sub CGI::Util::CORE:subst; # opcode
# spent 115µs within CGI::Util::CORE:substcont which was called 30 times, avg 4µs/call: # 30 times (115µs+0s) by CGI::Util::escape at line 255, avg 4µs/call
sub CGI::Util::CORE:substcont; # opcode
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.