Filename | /usr/share/perl5/vendor_perl/CGI/Cookie.pm |
Statements | Executed 16 statements in 1.45ms |
Calls | P | F | Exclusive Time |
Inclusive Time |
Subroutine |
---|---|---|---|---|---|
1 | 1 | 1 | 17µs | 67µs | BEGIN@22 | CGI::Cookie::
1 | 1 | 1 | 15µs | 44µs | BEGIN@21 | CGI::Cookie::
1 | 1 | 1 | 14µs | 27µs | BEGIN@3 | CGI::Cookie::
1 | 1 | 1 | 12µs | 26µs | BEGIN@149 | CGI::Cookie::
1 | 1 | 1 | 8µs | 14µs | BEGIN@4 | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | as_string | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | bake | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | compare | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | domain | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | expires | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | fetch | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | get_raw_cookie | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | httponly | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | max_age | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | name | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | new | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | parse | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | path | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | raw_fetch | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | secure | CGI::Cookie::
0 | 0 | 0 | 0s | 0s | value | CGI::Cookie::
Line | State ments |
Time on line |
Calls | Time in subs |
Code |
---|---|---|---|---|---|
1 | package CGI::Cookie; | ||||
2 | |||||
3 | 2 | 26µs | 2 | 40µs | # spent 27µs (14+13) within CGI::Cookie::BEGIN@3 which was called:
# once (14µs+13µs) by Foswiki::Plugins::TwistyPlugin::BEGIN@12 at line 3 # spent 27µs making 1 call to CGI::Cookie::BEGIN@3
# spent 13µs making 1 call to strict::import |
4 | 2 | 42µs | 2 | 20µs | # spent 14µs (8+6) within CGI::Cookie::BEGIN@4 which was called:
# once (8µs+6µs) by Foswiki::Plugins::TwistyPlugin::BEGIN@12 at line 4 # spent 14µs making 1 call to CGI::Cookie::BEGIN@4
# spent 6µs making 1 call to warnings::import |
5 | |||||
6 | # See the bottom of this file for the POD documentation. Search for the | ||||
7 | # string '=head'. | ||||
8 | |||||
9 | # You can run this file through either pod2man or pod2html to produce pretty | ||||
10 | # documentation in manual or html file format (these utilities are part of the | ||||
11 | # Perl 5 distribution). | ||||
12 | |||||
13 | # Copyright 1995-1999, Lincoln D. Stein. All rights reserved. | ||||
14 | # It may be used and modified freely, but I do request that this copyright | ||||
15 | # notice remain attached to the file. You may modify this module as you | ||||
16 | # wish, but if you redistribute a modified version, please attach a note | ||||
17 | # listing the modifications you have made. | ||||
18 | |||||
19 | 1 | 700ns | our $VERSION='1.30'; | ||
20 | |||||
21 | 2 | 47µs | 2 | 73µs | # spent 44µs (15+29) within CGI::Cookie::BEGIN@21 which was called:
# once (15µs+29µs) by Foswiki::Plugins::TwistyPlugin::BEGIN@12 at line 21 # spent 44µs making 1 call to CGI::Cookie::BEGIN@21
# spent 29µs making 1 call to Exporter::import |
22 | 2 | 667µs | 2 | 117µs | # spent 67µs (17+50) within CGI::Cookie::BEGIN@22 which was called:
# once (17µs+50µs) by Foswiki::Plugins::TwistyPlugin::BEGIN@12 at line 22 # spent 67µs making 1 call to CGI::Cookie::BEGIN@22
# spent 50µs making 1 call to overload::import |
23 | |||||
24 | 1 | 300ns | my $PERLEX = 0; | ||
25 | # Turn on special checking for ActiveState's PerlEx | ||||
26 | 1 | 800ns | $PERLEX++ if defined($ENV{'GATEWAY_INTERFACE'}) && $ENV{'GATEWAY_INTERFACE'} =~ /^CGI-PerlEx/; | ||
27 | |||||
28 | # Turn on special checking for mod_perl | ||||
29 | # PerlEx::DBI tries to fool DBI by setting MOD_PERL | ||||
30 | 1 | 100ns | my $MOD_PERL = 0; | ||
31 | 1 | 600ns | if (exists $ENV{MOD_PERL} && ! $PERLEX) { | ||
32 | if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { | ||||
33 | $MOD_PERL = 2; | ||||
34 | require Apache2::RequestUtil; | ||||
35 | require APR::Table; | ||||
36 | } else { | ||||
37 | $MOD_PERL = 1; | ||||
38 | require Apache; | ||||
39 | } | ||||
40 | } | ||||
41 | |||||
42 | # fetch a list of cookies from the environment and | ||||
43 | # return as a hash. the cookies are parsed as normal | ||||
44 | # escaped URL data. | ||||
45 | sub fetch { | ||||
46 | my $class = shift; | ||||
47 | my $raw_cookie = get_raw_cookie(@_) or return; | ||||
48 | return $class->parse($raw_cookie); | ||||
49 | } | ||||
50 | |||||
51 | # Fetch a list of cookies from the environment or the incoming headers and | ||||
52 | # return as a hash. The cookie values are not unescaped or altered in any way. | ||||
53 | sub raw_fetch { | ||||
54 | my $class = shift; | ||||
55 | my $raw_cookie = get_raw_cookie(@_) or return; | ||||
56 | my %results; | ||||
57 | my($key,$value); | ||||
58 | |||||
59 | my @pairs = split("[;,] ?",$raw_cookie); | ||||
60 | for my $pair ( @pairs ) { | ||||
61 | $pair =~ s/^\s+|\s+$//g; # trim leading trailing whitespace | ||||
62 | my ( $key, $value ) = split "=", $pair; | ||||
63 | |||||
64 | $value = defined $value ? $value : ''; | ||||
65 | $results{$key} = $value; | ||||
66 | } | ||||
67 | return wantarray ? %results : \%results; | ||||
68 | } | ||||
69 | |||||
70 | sub get_raw_cookie { | ||||
71 | my $r = shift; | ||||
72 | $r ||= eval { $MOD_PERL == 2 ? | ||||
73 | Apache2::RequestUtil->request() : | ||||
74 | Apache->request } if $MOD_PERL; | ||||
75 | |||||
76 | return $r->headers_in->{'Cookie'} if $r; | ||||
77 | |||||
78 | die "Run $r->subprocess_env; before calling fetch()" | ||||
79 | if $MOD_PERL and !exists $ENV{REQUEST_METHOD}; | ||||
80 | |||||
81 | return $ENV{HTTP_COOKIE} || $ENV{COOKIE}; | ||||
82 | } | ||||
83 | |||||
84 | |||||
85 | sub parse { | ||||
86 | my ($self,$raw_cookie) = @_; | ||||
87 | return wantarray ? () : {} unless $raw_cookie; | ||||
88 | |||||
89 | my %results; | ||||
90 | |||||
91 | my @pairs = split("[;,] ?",$raw_cookie); | ||||
92 | for (@pairs) { | ||||
93 | s/^\s+//; | ||||
94 | s/\s+$//; | ||||
95 | |||||
96 | my($key,$value) = split("=",$_,2); | ||||
97 | |||||
98 | # Some foreign cookies are not in name=value format, so ignore | ||||
99 | # them. | ||||
100 | next if !defined($value); | ||||
101 | my @values = (); | ||||
102 | if ($value ne '') { | ||||
103 | @values = map unescape($_),split(/[&;]/,$value.'&dmy'); | ||||
104 | pop @values; | ||||
105 | } | ||||
106 | $key = unescape($key); | ||||
107 | # A bug in Netscape can cause several cookies with same name to | ||||
108 | # appear. The FIRST one in HTTP_COOKIE is the most recent version. | ||||
109 | $results{$key} ||= $self->new(-name=>$key,-value=>\@values); | ||||
110 | } | ||||
111 | return wantarray ? %results : \%results; | ||||
112 | } | ||||
113 | |||||
114 | sub new { | ||||
115 | my ( $class, @params ) = @_; | ||||
116 | $class = ref( $class ) || $class; | ||||
117 | # Ignore mod_perl request object--compatibility with Apache::Cookie. | ||||
118 | shift if ref $params[0] | ||||
119 | && eval { $params[0]->isa('Apache::Request::Req') || $params[0]->isa('Apache') }; | ||||
120 | my ( $name, $value, $path, $domain, $secure, $expires, $max_age, $httponly ) | ||||
121 | = rearrange( | ||||
122 | [ | ||||
123 | 'NAME', [ 'VALUE', 'VALUES' ], | ||||
124 | 'PATH', 'DOMAIN', | ||||
125 | 'SECURE', 'EXPIRES', | ||||
126 | 'MAX-AGE','HTTPONLY' | ||||
127 | ], | ||||
128 | @params | ||||
129 | ); | ||||
130 | return undef unless defined $name and defined $value; | ||||
131 | my $self = {}; | ||||
132 | bless $self, $class; | ||||
133 | $self->name( $name ); | ||||
134 | $self->value( $value ); | ||||
135 | $path ||= "/"; | ||||
136 | $self->path( $path ) if defined $path; | ||||
137 | $self->domain( $domain ) if defined $domain; | ||||
138 | $self->secure( $secure ) if defined $secure; | ||||
139 | $self->expires( $expires ) if defined $expires; | ||||
140 | $self->max_age($expires) if defined $max_age; | ||||
141 | $self->httponly( $httponly ) if defined $httponly; | ||||
142 | return $self; | ||||
143 | } | ||||
144 | |||||
145 | sub as_string { | ||||
146 | my $self = shift; | ||||
147 | return "" unless $self->name; | ||||
148 | |||||
149 | 2 | 653µs | 2 | 39µs | # spent 26µs (12+13) within CGI::Cookie::BEGIN@149 which was called:
# once (12µs+13µs) by Foswiki::Plugins::TwistyPlugin::BEGIN@12 at line 149 # spent 26µs making 1 call to CGI::Cookie::BEGIN@149
# spent 13µs making 1 call to warnings::unimport |
150 | |||||
151 | my $name = escape( $self->name ); | ||||
152 | my $value = join "&", map { escape($_) } $self->value; | ||||
153 | my @cookie = ( "$name=$value" ); | ||||
154 | |||||
155 | push @cookie,"domain=".$self->domain if $self->domain; | ||||
156 | push @cookie,"path=".$self->path if $self->path; | ||||
157 | push @cookie,"expires=".$self->expires if $self->expires; | ||||
158 | push @cookie,"max-age=".$self->max_age if $self->max_age; | ||||
159 | push @cookie,"secure" if $self->secure; | ||||
160 | push @cookie,"HttpOnly" if $self->httponly; | ||||
161 | |||||
162 | return join "; ", @cookie; | ||||
163 | } | ||||
164 | |||||
165 | sub compare { | ||||
166 | my ( $self, $value ) = @_; | ||||
167 | return "$self" cmp $value; | ||||
168 | } | ||||
169 | |||||
170 | sub bake { | ||||
171 | my ($self, $r) = @_; | ||||
172 | |||||
173 | $r ||= eval { | ||||
174 | $MOD_PERL == 2 | ||||
175 | ? Apache2::RequestUtil->request() | ||||
176 | : Apache->request | ||||
177 | } if $MOD_PERL; | ||||
178 | if ($r) { | ||||
179 | $r->headers_out->add('Set-Cookie' => $self->as_string); | ||||
180 | } else { | ||||
181 | require CGI; | ||||
182 | print CGI::header(-cookie => $self); | ||||
183 | } | ||||
184 | |||||
185 | } | ||||
186 | |||||
187 | # accessors | ||||
188 | sub name { | ||||
189 | my ( $self, $name ) = @_; | ||||
190 | $self->{'name'} = $name if defined $name; | ||||
191 | return $self->{'name'}; | ||||
192 | } | ||||
193 | |||||
194 | sub value { | ||||
195 | my ( $self, $value ) = @_; | ||||
196 | if ( defined $value ) { | ||||
197 | my @values | ||||
198 | = ref $value eq 'ARRAY' ? @$value | ||||
199 | : ref $value eq 'HASH' ? %$value | ||||
200 | : ( $value ); | ||||
201 | $self->{'value'} = [@values]; | ||||
202 | } | ||||
203 | return wantarray ? @{ $self->{'value'} } : $self->{'value'}->[0]; | ||||
204 | } | ||||
205 | |||||
206 | sub domain { | ||||
207 | my ( $self, $domain ) = @_; | ||||
208 | $self->{'domain'} = lc $domain if defined $domain; | ||||
209 | return $self->{'domain'}; | ||||
210 | } | ||||
211 | |||||
212 | sub secure { | ||||
213 | my ( $self, $secure ) = @_; | ||||
214 | $self->{'secure'} = $secure if defined $secure; | ||||
215 | return $self->{'secure'}; | ||||
216 | } | ||||
217 | |||||
218 | sub expires { | ||||
219 | my ( $self, $expires ) = @_; | ||||
220 | $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires; | ||||
221 | return $self->{'expires'}; | ||||
222 | } | ||||
223 | |||||
224 | sub max_age { | ||||
225 | my ( $self, $max_age ) = @_; | ||||
226 | $self->{'max-age'} = CGI::Util::expire_calc($max_age)-time() if defined $max_age; | ||||
227 | return $self->{'max-age'}; | ||||
228 | } | ||||
229 | |||||
230 | sub path { | ||||
231 | my ( $self, $path ) = @_; | ||||
232 | $self->{'path'} = $path if defined $path; | ||||
233 | return $self->{'path'}; | ||||
234 | } | ||||
235 | |||||
236 | |||||
237 | sub httponly { # HttpOnly | ||||
238 | my ( $self, $httponly ) = @_; | ||||
239 | $self->{'httponly'} = $httponly if defined $httponly; | ||||
240 | return $self->{'httponly'}; | ||||
241 | } | ||||
242 | |||||
243 | 1 | 8µs | 1; | ||
244 | |||||
245 | =head1 NAME | ||||
246 | |||||
247 | CGI::Cookie - Interface to HTTP Cookies | ||||
248 | |||||
249 | =head1 SYNOPSIS | ||||
250 | |||||
251 | use CGI qw/:standard/; | ||||
252 | use CGI::Cookie; | ||||
253 | |||||
254 | # Create new cookies and send them | ||||
255 | $cookie1 = CGI::Cookie->new(-name=>'ID',-value=>123456); | ||||
256 | $cookie2 = CGI::Cookie->new(-name=>'preferences', | ||||
257 | -value=>{ font => Helvetica, | ||||
258 | size => 12 } | ||||
259 | ); | ||||
260 | print header(-cookie=>[$cookie1,$cookie2]); | ||||
261 | |||||
262 | # fetch existing cookies | ||||
263 | %cookies = CGI::Cookie->fetch; | ||||
264 | $id = $cookies{'ID'}->value; | ||||
265 | |||||
266 | # create cookies returned from an external source | ||||
267 | %cookies = CGI::Cookie->parse($ENV{COOKIE}); | ||||
268 | |||||
269 | =head1 DESCRIPTION | ||||
270 | |||||
271 | CGI::Cookie is an interface to HTTP/1.1 cookies, an | ||||
272 | innovation that allows Web servers to store persistent information on | ||||
273 | the browser's side of the connection. Although CGI::Cookie is | ||||
274 | intended to be used in conjunction with CGI.pm (and is in fact used by | ||||
275 | it internally), you can use this module independently. | ||||
276 | |||||
277 | For full information on cookies see | ||||
278 | |||||
279 | http://tools.ietf.org/html/rfc2109 | ||||
280 | http://tools.ietf.org/html/rfc2965 | ||||
281 | http://tools.ietf.org/html/draft-ietf-httpstate-cookie | ||||
282 | |||||
283 | =head1 USING CGI::Cookie | ||||
284 | |||||
285 | CGI::Cookie is object oriented. Each cookie object has a name and a | ||||
286 | value. The name is any scalar value. The value is any scalar or | ||||
287 | array value (associative arrays are also allowed). Cookies also have | ||||
288 | several optional attributes, including: | ||||
289 | |||||
290 | =over 4 | ||||
291 | |||||
292 | =item B<1. expiration date> | ||||
293 | |||||
294 | The expiration date tells the browser how long to hang on to the | ||||
295 | cookie. If the cookie specifies an expiration date in the future, the | ||||
296 | browser will store the cookie information in a disk file and return it | ||||
297 | to the server every time the user reconnects (until the expiration | ||||
298 | date is reached). If the cookie species an expiration date in the | ||||
299 | past, the browser will remove the cookie from the disk file. If the | ||||
300 | expiration date is not specified, the cookie will persist only until | ||||
301 | the user quits the browser. | ||||
302 | |||||
303 | =item B<2. domain> | ||||
304 | |||||
305 | This is a partial or complete domain name for which the cookie is | ||||
306 | valid. The browser will return the cookie to any host that matches | ||||
307 | the partial domain name. For example, if you specify a domain name | ||||
308 | of ".capricorn.com", then the browser will return the cookie to | ||||
309 | Web servers running on any of the machines "www.capricorn.com", | ||||
310 | "ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names | ||||
311 | must contain at least two periods to prevent attempts to match | ||||
312 | on top level domains like ".edu". If no domain is specified, then | ||||
313 | the browser will only return the cookie to servers on the host the | ||||
314 | cookie originated from. | ||||
315 | |||||
316 | =item B<3. path> | ||||
317 | |||||
318 | If you provide a cookie path attribute, the browser will check it | ||||
319 | against your script's URL before returning the cookie. For example, | ||||
320 | if you specify the path "/cgi-bin", then the cookie will be returned | ||||
321 | to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and | ||||
322 | "/cgi-bin/customer_service/complain.pl", but not to the script | ||||
323 | "/cgi-private/site_admin.pl". By default, the path is set to "/", so | ||||
324 | that all scripts at your site will receive the cookie. | ||||
325 | |||||
326 | =item B<4. secure flag> | ||||
327 | |||||
328 | If the "secure" attribute is set, the cookie will only be sent to your | ||||
329 | script if the CGI request is occurring on a secure channel, such as SSL. | ||||
330 | |||||
331 | =item B<5. httponly flag> | ||||
332 | |||||
333 | If the "httponly" attribute is set, the cookie will only be accessible | ||||
334 | through HTTP Requests. This cookie will be inaccessible via JavaScript | ||||
335 | (to prevent XSS attacks). | ||||
336 | |||||
337 | This feature is only supported by recent browsers like Internet Explorer | ||||
338 | 6 Service Pack 1, Firefox 3.0 and Opera 9.5 (and later of course). | ||||
339 | |||||
340 | See these URLs for more information: | ||||
341 | |||||
342 | http://msdn.microsoft.com/en-us/library/ms533046.aspx | ||||
343 | http://www.owasp.org/index.php/HTTPOnly#Browsers_Supporting_HTTPOnly | ||||
344 | |||||
345 | =back | ||||
346 | |||||
347 | =head2 Creating New Cookies | ||||
348 | |||||
349 | my $c = CGI::Cookie->new(-name => 'foo', | ||||
350 | -value => 'bar', | ||||
351 | -expires => '+3M', | ||||
352 | -domain => '.capricorn.com', | ||||
353 | -path => '/cgi-bin/database', | ||||
354 | -secure => 1 | ||||
355 | ); | ||||
356 | |||||
357 | Create cookies from scratch with the B<new> method. The B<-name> and | ||||
358 | B<-value> parameters are required. The name must be a scalar value. | ||||
359 | The value can be a scalar, an array reference, or a hash reference. | ||||
360 | (At some point in the future cookies will support one of the Perl | ||||
361 | object serialization protocols for full generality). | ||||
362 | |||||
363 | B<-expires> accepts any of the relative or absolute date formats | ||||
364 | recognized by CGI.pm, for example "+3M" for three months in the | ||||
365 | future. See CGI.pm's documentation for details. | ||||
366 | |||||
367 | B<-max-age> accepts the same data formats as B<< -expires >>, but sets a | ||||
368 | relative value instead of an absolute like B<< -expires >>. This is intended to be | ||||
369 | more secure since a clock could be changed to fake an absolute time. In | ||||
370 | practice, as of 2011, C<< -max-age >> still does not enjoy the widespread support | ||||
371 | that C<< -expires >> has. You can set both, and browsers that support | ||||
372 | C<< -max-age >> should ignore the C<< Expires >> header. The drawback | ||||
373 | to this approach is the bit of bandwidth for sending an extra header on each cookie. | ||||
374 | |||||
375 | B<-domain> points to a domain name or to a fully qualified host name. | ||||
376 | If not specified, the cookie will be returned only to the Web server | ||||
377 | that created it. | ||||
378 | |||||
379 | B<-path> points to a partial URL on the current server. The cookie | ||||
380 | will be returned to all URLs beginning with the specified path. If | ||||
381 | not specified, it defaults to '/', which returns the cookie to all | ||||
382 | pages at your site. | ||||
383 | |||||
384 | B<-secure> if set to a true value instructs the browser to return the | ||||
385 | cookie only when a cryptographic protocol is in use. | ||||
386 | |||||
387 | B<-httponly> if set to a true value, the cookie will not be accessible | ||||
388 | via JavaScript. | ||||
389 | |||||
390 | For compatibility with Apache::Cookie, you may optionally pass in | ||||
391 | a mod_perl request object as the first argument to C<new()>. It will | ||||
392 | simply be ignored: | ||||
393 | |||||
394 | my $c = CGI::Cookie->new($r, | ||||
395 | -name => 'foo', | ||||
396 | -value => ['bar','baz']); | ||||
397 | |||||
398 | =head2 Sending the Cookie to the Browser | ||||
399 | |||||
400 | The simplest way to send a cookie to the browser is by calling the bake() | ||||
401 | method: | ||||
402 | |||||
403 | $c->bake; | ||||
404 | |||||
405 | This will print the Set-Cookie HTTP header to STDOUT using CGI.pm. CGI.pm | ||||
406 | will be loaded for this purpose if it is not already. Otherwise CGI.pm is not | ||||
407 | required or used by this module. | ||||
408 | |||||
409 | Under mod_perl, pass in an Apache request object: | ||||
410 | |||||
411 | $c->bake($r); | ||||
412 | |||||
413 | If you want to set the cookie yourself, Within a CGI script you can send | ||||
414 | a cookie to the browser by creating one or more Set-Cookie: fields in the | ||||
415 | HTTP header. Here is a typical sequence: | ||||
416 | |||||
417 | my $c = CGI::Cookie->new(-name => 'foo', | ||||
418 | -value => ['bar','baz'], | ||||
419 | -expires => '+3M'); | ||||
420 | |||||
421 | print "Set-Cookie: $c\n"; | ||||
422 | print "Content-Type: text/html\n\n"; | ||||
423 | |||||
424 | To send more than one cookie, create several Set-Cookie: fields. | ||||
425 | |||||
426 | If you are using CGI.pm, you send cookies by providing a -cookie | ||||
427 | argument to the header() method: | ||||
428 | |||||
429 | print header(-cookie=>$c); | ||||
430 | |||||
431 | Mod_perl users can set cookies using the request object's header_out() | ||||
432 | method: | ||||
433 | |||||
434 | $r->headers_out->set('Set-Cookie' => $c); | ||||
435 | |||||
436 | Internally, Cookie overloads the "" operator to call its as_string() | ||||
437 | method when incorporated into the HTTP header. as_string() turns the | ||||
438 | Cookie's internal representation into an RFC-compliant text | ||||
439 | representation. You may call as_string() yourself if you prefer: | ||||
440 | |||||
441 | print "Set-Cookie: ",$c->as_string,"\n"; | ||||
442 | |||||
443 | =head2 Recovering Previous Cookies | ||||
444 | |||||
445 | %cookies = CGI::Cookie->fetch; | ||||
446 | |||||
447 | B<fetch> returns an associative array consisting of all cookies | ||||
448 | returned by the browser. The keys of the array are the cookie names. You | ||||
449 | can iterate through the cookies this way: | ||||
450 | |||||
451 | %cookies = CGI::Cookie->fetch; | ||||
452 | for (keys %cookies) { | ||||
453 | do_something($cookies{$_}); | ||||
454 | } | ||||
455 | |||||
456 | In a scalar context, fetch() returns a hash reference, which may be more | ||||
457 | efficient if you are manipulating multiple cookies. | ||||
458 | |||||
459 | CGI.pm uses the URL escaping methods to save and restore reserved characters | ||||
460 | in its cookies. If you are trying to retrieve a cookie set by a foreign server, | ||||
461 | this escaping method may trip you up. Use raw_fetch() instead, which has the | ||||
462 | same semantics as fetch(), but performs no unescaping. | ||||
463 | |||||
464 | You may also retrieve cookies that were stored in some external | ||||
465 | form using the parse() class method: | ||||
466 | |||||
467 | $COOKIES = `cat /usr/tmp/Cookie_stash`; | ||||
468 | %cookies = CGI::Cookie->parse($COOKIES); | ||||
469 | |||||
470 | If you are in a mod_perl environment, you can save some overhead by | ||||
471 | passing the request object to fetch() like this: | ||||
472 | |||||
473 | CGI::Cookie->fetch($r); | ||||
474 | |||||
475 | If the value passed to parse() is undefined, an empty array will returned in list | ||||
476 | context, and an empty hashref will be returned in scalar context. | ||||
477 | |||||
478 | =head2 Manipulating Cookies | ||||
479 | |||||
480 | Cookie objects have a series of accessor methods to get and set cookie | ||||
481 | attributes. Each accessor has a similar syntax. Called without | ||||
482 | arguments, the accessor returns the current value of the attribute. | ||||
483 | Called with an argument, the accessor changes the attribute and | ||||
484 | returns its new value. | ||||
485 | |||||
486 | =over 4 | ||||
487 | |||||
488 | =item B<name()> | ||||
489 | |||||
490 | Get or set the cookie's name. Example: | ||||
491 | |||||
492 | $name = $c->name; | ||||
493 | $new_name = $c->name('fred'); | ||||
494 | |||||
495 | =item B<value()> | ||||
496 | |||||
497 | Get or set the cookie's value. Example: | ||||
498 | |||||
499 | $value = $c->value; | ||||
500 | @new_value = $c->value(['a','b','c','d']); | ||||
501 | |||||
502 | B<value()> is context sensitive. In a list context it will return | ||||
503 | the current value of the cookie as an array. In a scalar context it | ||||
504 | will return the B<first> value of a multivalued cookie. | ||||
505 | |||||
506 | =item B<domain()> | ||||
507 | |||||
508 | Get or set the cookie's domain. | ||||
509 | |||||
510 | =item B<path()> | ||||
511 | |||||
512 | Get or set the cookie's path. | ||||
513 | |||||
514 | =item B<expires()> | ||||
515 | |||||
516 | Get or set the cookie's expiration time. | ||||
517 | |||||
518 | =back | ||||
519 | |||||
520 | |||||
521 | =head1 AUTHOR INFORMATION | ||||
522 | |||||
523 | Copyright 1997-1998, Lincoln D. Stein. All rights reserved. | ||||
524 | |||||
525 | This library is free software; you can redistribute it and/or modify | ||||
526 | it under the same terms as Perl itself. | ||||
527 | |||||
528 | Address bug reports and comments to: lstein@cshl.org | ||||
529 | |||||
530 | =head1 BUGS | ||||
531 | |||||
532 | This section intentionally left blank. | ||||
533 | |||||
534 | =head1 SEE ALSO | ||||
535 | |||||
536 | L<CGI::Carp>, L<CGI> | ||||
537 | |||||
538 | L<RFC 2109|http://www.ietf.org/rfc/rfc2109.txt>, L<RFC 2695|http://www.ietf.org/rfc/rfc2965.txt> | ||||
539 | |||||
540 | =cut |