← 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:27 2013

Filename/usr/share/perl/5.10/CGI/Cookie.pm
StatementsExecuted 276 statements in 3.11ms
Subroutines
Calls P F Exclusive
Time		 Inclusive
Time		 Subroutine
322289µs949µsCGI::Cookie::::as_stringCGI::Cookie::as_string
1111118µs208µsCGI::Cookie::::fetchCGI::Cookie::fetch
21199µs215µsCGI::Cookie::::newCGI::Cookie::new
111190µs90µsCGI::Cookie::::get_raw_cookieCGI::Cookie::get_raw_cookie
11138µs139µsCGI::Cookie::::BEGIN@18CGI::Cookie::BEGIN@18
62130µs30µsCGI::Cookie::::nameCGI::Cookie::name
52129µs29µsCGI::Cookie::::pathCGI::Cookie::path
11127µs107µsCGI::Cookie::::BEGIN@20CGI::Cookie::BEGIN@20
31125µs25µsCGI::Cookie::::valueCGI::Cookie::value
42122µs22µsCGI::Cookie::::httponlyCGI::Cookie::httponly
11118µs65µsCGI::Cookie::::BEGIN@19CGI::Cookie::BEGIN@19
31116µs16µsCGI::Cookie::::max_ageCGI::Cookie::max_age
31116µs16µsCGI::Cookie::::domainCGI::Cookie::domain
31115µs15µsCGI::Cookie::::expiresCGI::Cookie::expires
31114µs14µsCGI::Cookie::::secureCGI::Cookie::secure
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
1612µs$CGI::Cookie::VERSION='1.29';
17
18356µs2241µs
# spent 139µs (38+102) within CGI::Cookie::BEGIN@18 which was called: # once (38µs+102µs) by CGI::cookie at line 18
use CGI::Util qw(rearrange unescape escape);
# spent 139µs making 1 call to CGI::Cookie::BEGIN@18 # spent 102µs making 1 call to Exporter::import
19368µs2112µs
# spent 65µs (18+47) within CGI::Cookie::BEGIN@19 which was called: # once (18µs+47µs) by CGI::cookie at line 19
use CGI;
# spent 65µs making 1 call to CGI::Cookie::BEGIN@19 # spent 47µs making 1 call to CGI::import
20180µs
# spent 107µs (27+80) within CGI::Cookie::BEGIN@20 which was called: # once (27µs+80µs) by CGI::cookie at line 22
use overload '""' => \&as_string,
# spent 80µs making 1 call to overload::import
21 'cmp' => \&compare,
2232.20ms1107µs 'fallback'=>1;
# spent 107µs making 1 call to CGI::Cookie::BEGIN@20
23
24# Turn on special checking for Doug MacEachern's modperl
251900nsmy $MOD_PERL = 0;
2614µ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 208µs (118+90) within CGI::Cookie::fetch which was called 11 times, avg 19µs/call: # 11 times (118µs+90µs) by CGI::cookie at line 12 of (eval 1049)[CGI.pm:869], avg 19µs/call
sub fetch {
412287µs my $class = shift;
421190µs my $raw_cookie = get_raw_cookie(@_) or return;
# spent 90µs making 11 calls to CGI::Cookie::get_raw_cookie, avg 8µ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 90µs within CGI::Cookie::get_raw_cookie which was called 11 times, avg 8µs/call: # 11 times (90µs+0s) by CGI::Cookie::fetch at line 42, avg 8µs/call
sub get_raw_cookie {
7255122µ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 215µs (99+116) within CGI::Cookie::new which was called 2 times, avg 108µs/call: # 2 times (99µs+116µs) by CGI::cookie at line 34 of (eval 1049)[CGI.pm:869], avg 108µs/call
sub new {
11430100µ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') };
119298µs my($name,$value,$path,$domain,$secure,$expires,$httponly) =
# spent 98µs making 2 calls to CGI::Util::rearrange, avg 49µ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
145212µs $self->path($path) if defined $path;
# spent 12µs making 2 calls to CGI::Cookie::path, avg 6µs/call
146 $self->domain($domain) if defined $domain;
147 $self->secure($secure) if defined $secure;
148 $self->expires($expires) if defined $expires;
14916µs $self->httponly($httponly) if defined $httponly;
# spent 6µs making 1 call to CGI::Cookie::httponly
150# $self->max_age($expires) if defined $expires;
151 return $self;
152}
153
154
# spent 949µs (289+661) within CGI::Cookie::as_string which was called 3 times, avg 316µs/call: # 2 times (213µs+577µs) by CGI::header at line 17 of (eval 1149)[CGI.pm:869], avg 395µs/call # once (76µs+84µs) by C4::Auth::checkauth at line 1033 of /usr/share/koha/lib/C4/Auth.pm
sub as_string {
15536187µs my $self = shift;
156318µs return "" unless $self->name;
# spent 18µ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
160316µs push(@constant_values,"domain=$domain") if $domain = $self->domain;
# spent 16µs making 3 calls to CGI::Cookie::domain, avg 5µ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
162315µs push(@constant_values,"expires=$expires") if $expires = $self->expires;
# spent 15µs making 3 calls to CGI::Cookie::expires, avg 5µs/call
163316µs push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age;
# spent 16µs making 3 calls to CGI::Cookie::max_age, avg 5µ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
165317µs push(@constant_values,"HttpOnly") if $httponly = $self->httponly;
# spent 17µs making 3 calls to CGI::Cookie::httponly, avg 6µs/call
166
167697µs my($key) = escape($self->name);
# spent 85µs making 3 calls to CGI::Util::escape, avg 28µs/call # spent 13µs making 3 calls to CGI::Cookie::name, avg 4µs/call
1686451µs my($cookie) = join("=",(defined $key ? $key : ''),join("&",map escape(defined $_ ? $_ : ''),$self->value));
# spent 427µs making 3 calls to CGI::Util::escape, avg 142µs/call # spent 25µs making 3 calls to CGI::Cookie::value, avg 8µ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 30µs within CGI::Cookie::name which was called 6 times, avg 5µs/call: # 3 times (18µs+0s) by CGI::Cookie::as_string at line 156, avg 6µs/call # 3 times (13µs+0s) by CGI::Cookie::as_string at line 167, avg 4µs/call
sub name {
1962444µs my $self = shift;
197 my $name = shift;
198 $self->{'name'} = $name if defined $name;
199 return $self->{'name'};
200}
201
202
# spent 25µs within CGI::Cookie::value which was called 3 times, avg 8µs/call: # 3 times (25µs+0s) by CGI::Cookie::as_string at line 168, avg 8µs/call
sub value {
2031230µ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 16µs within CGI::Cookie::domain which was called 3 times, avg 5µs/call: # 3 times (16µs+0s) by CGI::Cookie::as_string at line 160, avg 5µs/call
sub domain {
2221221µ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 {
2291276µs my $self = shift;
230 my $secure = shift;
231 $self->{'secure'} = $secure if defined $secure;
232 return $self->{'secure'};
233}
234
235
# spent 15µs within CGI::Cookie::expires which was called 3 times, avg 5µs/call: # 3 times (15µs+0s) by CGI::Cookie::as_string at line 162, avg 5µs/call
sub expires {
2361219µ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 16µs within CGI::Cookie::max_age which was called 3 times, avg 5µs/call: # 3 times (16µs+0s) by CGI::Cookie::as_string at line 163, avg 5µs/call
sub max_age {
2431221µ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 29µs within CGI::Cookie::path which was called 5 times, avg 6µs/call: # 3 times (16µs+0s) by CGI::Cookie::as_string at line 161, avg 5µs/call # 2 times (12µs+0s) by CGI::Cookie::new at line 145, avg 6µs/call
sub path {
2502036µs my $self = shift;
251 my $path = shift;
252 $self->{'path'} = $path if defined $path;
253 return $self->{'path'};
254}
255
256
257
# spent 22µs within CGI::Cookie::httponly which was called 4 times, avg 6µs/call: # 3 times (17µs+0s) by CGI::Cookie::as_string at line 165, avg 6µs/call # once (6µ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
264110µs1;
265
266=head1 NAME
267
- -
Report produced by the NYTProf 4.04 Perl profiler, developed by Tim Bunce and Adam Kaplan.