← 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 11:58:52 2013
Reported on Tue Oct 15 12:01:07 2013

Filename/usr/share/perl/5.10/CGI/Cookie.pm
StatementsExecuted 276 statements in 2.21ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
322215µs612µsCGI::Cookie::::as_stringCGI::Cookie::as_string
211164µs387µsCGI::Cookie::::newCGI::Cookie::new
1111104µs197µsCGI::Cookie::::fetchCGI::Cookie::fetch
111194µs94µsCGI::Cookie::::get_raw_cookieCGI::Cookie::get_raw_cookie
52139µs39µsCGI::Cookie::::pathCGI::Cookie::path
11131µs123µsCGI::Cookie::::BEGIN@18CGI::Cookie::BEGIN@18
31127µs27µsCGI::Cookie::::expiresCGI::Cookie::expires
62126µs26µsCGI::Cookie::::nameCGI::Cookie::name
42121µs21µsCGI::Cookie::::httponlyCGI::Cookie::httponly
31120µs20µsCGI::Cookie::::max_ageCGI::Cookie::max_age
31119µs19µsCGI::Cookie::::valueCGI::Cookie::value
11119µs72µsCGI::Cookie::::BEGIN@20CGI::Cookie::BEGIN@20
31114µs14µsCGI::Cookie::::secureCGI::Cookie::secure
31113µs13µsCGI::Cookie::::domainCGI::Cookie::domain
11111µs41µsCGI::Cookie::::BEGIN@19CGI::Cookie::BEGIN@19
0000s0sCGI::Cookie::::bakeCGI::Cookie::bake
0000s0sCGI::Cookie::::compareCGI::Cookie::compare
0000s0sCGI::Cookie::::parseCGI::Cookie::parse
0000s0sCGI::Cookie::::raw_fetchCGI::Cookie::raw_fetch
Call graph for these subroutines as a Graphviz dot language file.
Line State
ments		 Time
on line		 Calls Time
in subs		 Code
1package CGI::Cookie;
2
3# See the bottom of this file for the POD documentation. Search for the
4# string '=head'.
5
6# You can run this file through either pod2man or pod2html to produce pretty
7# documentation in manual or html file format (these utilities are part of the
8# Perl 5 distribution).
9
10# Copyright 1995-1999, Lincoln D. Stein. All rights reserved.
11# It may be used and modified freely, but I do request that this copyright
12# notice remain attached to the file. You may modify this module as you
13# wish, but if you redistribute a modified version, please attach a note
14# listing the modifications you have made.
15
161800ns$CGI::Cookie::VERSION='1.29';
17
18345µs2215µs
# spent 123µs (31+92) within CGI::Cookie::BEGIN@18 which was called: # once (31µs+92µs) by CGI::cookie at line 18
use CGI::Util qw(rearrange unescape escape);
# spent 123µs making 1 call to CGI::Cookie::BEGIN@18 # spent 92µs making 1 call to Exporter::import
19345µs271µs
# spent 41µs (11+30) within CGI::Cookie::BEGIN@19 which was called: # once (11µs+30µs) by CGI::cookie at line 19
use CGI;
# spent 41µs making 1 call to CGI::Cookie::BEGIN@19 # spent 30µs making 1 call to CGI::import
20152µs
# spent 72µs (19+53) within CGI::Cookie::BEGIN@20 which was called: # once (19µs+53µs) by CGI::cookie at line 22
use overload '""' => \&as_string,
# spent 52µs making 1 call to overload::import
21 'cmp' => \&compare,
2231.35ms172µs 'fallback'=>1;
# spent 72µs making 1 call to CGI::Cookie::BEGIN@20
23
24# Turn on special checking for Doug MacEachern's modperl
251500nsmy $MOD_PERL = 0;
2612µsif (exists $ENV{MOD_PERL}) {
27 if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) {
28 $MOD_PERL = 2;
29 require Apache2::RequestUtil;
30 require APR::Table;
31 } else {
32 $MOD_PERL = 1;
33 require Apache;
34 }
35}
36
37# fetch a list of cookies from the environment and
38# return as a hash. the cookies are parsed as normal
39# escaped URL data.
40
# spent 197µs (104+94) within CGI::Cookie::fetch which was called 11 times, avg 18µs/call: # 11 times (104µs+94µs) by CGI::cookie at line 12 of (eval 1032)[CGI.pm:869], avg 18µs/call
sub fetch {
412290µs my $class = shift;
421194µs my $raw_cookie = get_raw_cookie(@_) or return;
# spent 94µs making 11 calls to CGI::Cookie::get_raw_cookie, avg 9µs/call
43 return $class->parse($raw_cookie);
44}
45
46# Fetch a list of cookies from the environment or the incoming headers and
47# return as a hash. The cookie values are not unescaped or altered in any way.
48 sub raw_fetch {
49 my $class = shift;
50 my $raw_cookie = get_raw_cookie(@_) or return;
51 my %results;
52 my($key,$value);
53
54 my @pairs = split("[;,] ?",$raw_cookie);
55 foreach (@pairs) {
56 s/\s*(.*?)\s*/$1/;
57 if (/^([^=]+)=(.*)/) {
58 $key = $1;
59 $value = $2;
60 }
61 else {
62 $key = $_;
63 $value = '';
64 }
65 $results{$key} = $value;
66 }
67 return \%results unless wantarray;
68 return %results;
69}
70
71
# spent 94µs within CGI::Cookie::get_raw_cookie which was called 11 times, avg 9µs/call: # 11 times (94µs+0s) by CGI::Cookie::fetch at line 42, avg 9µs/call
sub get_raw_cookie {
7255116µs my $r = shift;
73 $r ||= eval { $MOD_PERL == 2 ?
74 Apache2::RequestUtil->request() :
75 Apache->request } if $MOD_PERL;
76 if ($r) {
77 $raw_cookie = $r->headers_in->{'Cookie'};
78 } else {
79 if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) {
80 die "Run $r->subprocess_env; before calling fetch()";
81 }
82 $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE};
83 }
84}
85
86
87sub parse {
88 my ($self,$raw_cookie) = @_;
89 my %results;
90
91 my @pairs = split("[;,] ?",$raw_cookie);
92 foreach (@pairs) {
93 s/\s*(.*?)\s*/$1/;
94 my($key,$value) = split("=",$_,2);
95
96 # Some foreign cookies are not in name=value format, so ignore
97 # them.
98 next if !defined($value);
99 my @values = ();
100 if ($value ne '') {
101 @values = map unescape($_),split(/[&;]/,$value.'&dmy');
102 pop @values;
103 }
104 $key = unescape($key);
105 # A bug in Netscape can cause several cookies with same name to
106 # appear. The FIRST one in HTTP_COOKIE is the most recent version.
107 $results{$key} ||= $self->new(-name=>$key,-value=>\@values);
108 }
109 return \%results unless wantarray;
110 return %results;
111}
112
113
# spent 387µs (164+223) within CGI::Cookie::new which was called 2 times, avg 193µs/call: # 2 times (164µs+223µs) by CGI::cookie at line 34 of (eval 1032)[CGI.pm:869], avg 193µs/call
sub new {
11430150µs my $class = shift;
115 $class = ref($class) if ref($class);
116 # Ignore mod_perl request object--compatability with Apache::Cookie.
117 shift if ref $_[0]
118 && eval { $_[0]->isa('Apache::Request::Req') || $_[0]->isa('Apache') };
1192193µs my($name,$value,$path,$domain,$secure,$expires,$httponly) =
# spent 193µs making 2 calls to CGI::Util::rearrange, avg 97µs/call
120 rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES,HTTPONLY],@_);
121
122 # Pull out our parameters.
123 my @values;
124 if (ref($value)) {
125 if (ref($value) eq 'ARRAY') {
126 @values = @$value;
127 } elsif (ref($value) eq 'HASH') {
128 @values = %$value;
129 }
130 } else {
131 @values = ($value);
132 }
133
134 bless my $self = {
135 'name'=>$name,
136 'value'=>[@values],
137 },$class;
138
139 # IE requires the path and domain to be present for some reason.
140 $path ||= "/";
141 # however, this breaks networks which use host tables without fully qualified
142 # names, so we comment it out.
143 # $domain = CGI::virtual_host() unless defined $domain;
144
145223µs $self->path($path) if defined $path;
# spent 23µs making 2 calls to CGI::Cookie::path, avg 11µs/call
146 $self->domain($domain) if defined $domain;
147 $self->secure($secure) if defined $secure;
148 $self->expires($expires) if defined $expires;
14917µs $self->httponly($httponly) if defined $httponly;
# spent 7µs making 1 call to CGI::Cookie::httponly
150# $self->max_age($expires) if defined $expires;
151 return $self;
152}
153
154
# spent 612µs (215+397) within CGI::Cookie::as_string which was called 3 times, avg 204µs/call: # 2 times (101µs+267µs) by CGI::header at line 17 of (eval 1131)[CGI.pm:869], avg 184µs/call # once (114µs+129µs) by C4::Auth::checkauth at line 1034 of /usr/share/koha/lib/C4/Auth.pm
sub as_string {
15536169µs my $self = shift;
156317µs return "" unless $self->name;
# spent 17µs making 3 calls to CGI::Cookie::name, avg 6µs/call
157
158 my(@constant_values,$domain,$path,$expires,$max_age,$secure,$httponly);
159
160313µs push(@constant_values,"domain=$domain") if $domain = $self->domain;
# spent 13µs making 3 calls to CGI::Cookie::domain, avg 4µs/call
161316µs push(@constant_values,"path=$path") if $path = $self->path;
# spent 16µs making 3 calls to CGI::Cookie::path, avg 5µs/call
162327µs push(@constant_values,"expires=$expires") if $expires = $self->expires;
# spent 27µs making 3 calls to CGI::Cookie::expires, avg 9µs/call
163320µs push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
# spent 20µs making 3 calls to CGI::Cookie::max_age, avg 6µs/call
164314µs push(@constant_values,"secure") if $secure = $self->secure;
# spent 14µs making 3 calls to CGI::Cookie::secure, avg 5µs/call
165313µs push(@constant_values,"HttpOnly") if $httponly = $self->httponly;
# spent 13µs making 3 calls to CGI::Cookie::httponly, avg 4µs/call
166
167690µs my($key) = escape($self->name);
# spent 81µs making 3 calls to CGI::Util::escape, avg 27µs/call # spent 9µs making 3 calls to CGI::Cookie::name, avg 3µs/call
1686187µs my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
# spent 168µs making 3 calls to CGI::Util::escape, avg 56µs/call # spent 19µs making 3 calls to CGI::Cookie::value, avg 6µs/call
169 return join("; ",$cookie,@constant_values);
170}
171
172sub compare {
173 my $self = shift;
174 my $value = shift;
175 return "$self" cmp $value;
176}
177
178sub bake {
179 my ($self, $r) = @_;
180
181 $r ||= eval {
182 $MOD_PERL == 2
183 ? Apache2::RequestUtil->request()
184 : Apache->request
185 } if $MOD_PERL;
186 if ($r) {
187 $r->headers_out->add('Set-Cookie' => $self->as_string);
188 } else {
189 print CGI::header(-cookie => $self);
190 }
191
192}
193
194# accessors
195
# spent 26µs within CGI::Cookie::name which was called 6 times, avg 4µs/call: # 3 times (17µs+0s) by CGI::Cookie::as_string at line 156, avg 6µs/call # 3 times (9µs+0s) by CGI::Cookie::as_string at line 167, avg 3µs/call
sub name {
1962440µs my $self = shift;
197 my $name = shift;
198 $self->{'name'} = $name if defined $name;
199 return $self->{'name'};
200}
201
202
# spent 19µs within CGI::Cookie::value which was called 3 times, avg 6µs/call: # 3 times (19µs+0s) by CGI::Cookie::as_string at line 168, avg 6µs/call
sub value {
2031225µs my $self = shift;
204 my $value = shift;
205 if (defined $value) {
206 my @values;
207 if (ref($value)) {
208 if (ref($value) eq 'ARRAY') {
209 @values = @$value;
210 } elsif (ref($value) eq 'HASH') {
211 @values = %$value;
212 }
213 } else {
214 @values = ($value);
215 }
216 $self->{'value'} = [@values];
217 }
218 return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0]
219}
220
221
# spent 13µs within CGI::Cookie::domain which was called 3 times, avg 4µs/call: # 3 times (13µs+0s) by CGI::Cookie::as_string at line 160, avg 4µs/call
sub domain {
2221218µs my $self = shift;
223 my $domain = shift;
224 $self->{'domain'} = lc $domain if defined $domain;
225 return $self->{'domain'};
226}
227
228
# spent 14µs within CGI::Cookie::secure which was called 3 times, avg 5µs/call: # 3 times (14µs+0s) by CGI::Cookie::as_string at line 164, avg 5µs/call
sub secure {
2291218µs my $self = shift;
230 my $secure = shift;
231 $self->{'secure'} = $secure if defined $secure;
232 return $self->{'secure'};
233}
234
235
# spent 27µs within CGI::Cookie::expires which was called 3 times, avg 9µs/call: # 3 times (27µs+0s) by CGI::Cookie::as_string at line 162, avg 9µs/call
sub expires {
2361227µs my $self = shift;
237 my $expires = shift;
238 $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires;
239 return $self->{'expires'};
240}
241
242
# spent 20µs within CGI::Cookie::max_age which was called 3 times, avg 6µs/call: # 3 times (20µs+0s) by CGI::Cookie::as_string at line 163, avg 6µs/call
sub max_age {
2431226µs my $self = shift;
244 my $expires = shift;
245 $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires;
246 return $self->{'max-age'};
247}
248
249
# spent 39µs within CGI::Cookie::path which was called 5 times, avg 8µs/call: # 3 times (16µs+0s) by CGI::Cookie::as_string at line 161, avg 5µs/call # 2 times (23µs+0s) by CGI::Cookie::new at line 145, avg 11µs/call
sub path {
2502049µs my $self = shift;
251 my $path = shift;
252 $self->{'path'} = $path if defined $path;
253 return $self->{'path'};
254}
255
256
257
# spent 21µs within CGI::Cookie::httponly which was called 4 times, avg 5µs/call: # 3 times (13µs+0s) by CGI::Cookie::as_string at line 165, avg 4µs/call # once (7µs+0s) by CGI::Cookie::new at line 149
sub httponly { # HttpOnly
2581627µs my $self = shift;
259 my $httponly = shift;
260 $self->{'httponly'} = $httponly if defined $httponly;
261 return $self->{'httponly'};
262}
263
26417µs1;
265
266=head1 NAME
267
- -
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.