| File | /usr/share/perl/5.8/CGI/Cookie.pm | Statements Executed | 256 | Total Time | 0.0019 seconds |
| Calls | Inclusive Time | Subroutine | |
|---|---|---|---|
| 1 | 0.00019 | CGI::Cookie:: | new |
| 1 | 0.00012 | CGI::Cookie:: | as_string |
| 10 | 0.00009 | CGI::Cookie:: | name |
| 5 | 0.00007 | CGI::Cookie:: | secure |
| 6 | 0.00006 | CGI::Cookie:: | path |
| 2 | 0.00005 | CGI::Cookie:: | fetch |
| 5 | 0.00005 | CGI::Cookie:: | value |
| 5 | 0.00004 | CGI::Cookie:: | expires |
| 5 | 0.00004 | CGI::Cookie:: | domain |
| 5 | 0.00004 | CGI::Cookie:: | max_age |
| 2 | 0.00002 | CGI::Cookie:: | get_raw_cookie |
| 0 | 0 | CGI::Cookie:: | BEGIN |
| 0 | 0 | CGI::Cookie:: | compare |
| 0 | 0 | CGI::Cookie:: | parse |
| 0 | 0 | CGI::Cookie:: | raw_fetch |
| Line | Stmts. | Exclusive Time | Avg. | Code |
|---|---|---|---|---|
| 1 | package 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 | ||||
| 16 | 1 | 1e-06 | 1e-06 | $CGI::Cookie::VERSION='1.26'; |
| 17 | ||||
| 18 | 3 | 0.00006 | 0.00002 | use CGI::Util qw(rearrange unescape escape); # spent 0.00012s making 1 calls to Exporter::import |
| 19 | use overload '""' => \&as_string, # spent 0.00008s making 1 calls to overload::import | |||
| 20 | 'cmp' => \&compare, | |||
| 21 | 3 | 0.00134 | 0.00045 | 'fallback'=>1; |
| 22 | ||||
| 23 | # Turn on special checking for Doug MacEachern's modperl | |||
| 24 | 1 | 1e-06 | 1e-06 | my $MOD_PERL = 0; |
| 25 | 1 | 1e-06 | 1e-06 | if (exists $ENV{MOD_PERL}) { |
| 26 | if (exists $ENV{MOD_PERL_API_VERSION} && $ENV{MOD_PERL_API_VERSION} == 2) { | |||
| 27 | $MOD_PERL = 2; | |||
| 28 | require Apache2::RequestUtil; | |||
| 29 | require APR::Table; | |||
| 30 | } else { | |||
| 31 | $MOD_PERL = 1; | |||
| 32 | require Apache; | |||
| 33 | } | |||
| 34 | } | |||
| 35 | ||||
| 36 | # fetch a list of cookies from the environment and | |||
| 37 | # return as a hash. the cookies are parsed as normal | |||
| 38 | # escaped URL data. | |||
| 39 | # spent 0.00005s within CGI::Cookie::fetch which was called 2 times, avg 0.00002s/call:
# 2 times (0.00005s) by CGI::cookie at line 12 of /usr/share/perl/5.8/CGI.pm, avg 0.00002s/call sub fetch { | |||
| 40 | 4 | 0.00001 | 4e-06 | my $class = shift; |
| 41 | my $raw_cookie = get_raw_cookie(@_) or return; # spent 0.00002s making 2 calls to CGI::Cookie::get_raw_cookie, avg 0.00001s/call | |||
| 42 | return $class->parse($raw_cookie); | |||
| 43 | } | |||
| 44 | ||||
| 45 | # Fetch a list of cookies from the environment or the incoming headers and | |||
| 46 | # return as a hash. The cookie values are not unescaped or altered in any way. | |||
| 47 | sub raw_fetch { | |||
| 48 | my $class = shift; | |||
| 49 | my $raw_cookie = get_raw_cookie(@_) or return; | |||
| 50 | my %results; | |||
| 51 | my($key,$value); | |||
| 52 | ||||
| 53 | my(@pairs) = split("; ?",$raw_cookie); | |||
| 54 | foreach (@pairs) { | |||
| 55 | s/\s*(.*?)\s*/$1/; | |||
| 56 | if (/^([^=]+)=(.*)/) { | |||
| 57 | $key = $1; | |||
| 58 | $value = $2; | |||
| 59 | } | |||
| 60 | else { | |||
| 61 | $key = $_; | |||
| 62 | $value = ''; | |||
| 63 | } | |||
| 64 | $results{$key} = $value; | |||
| 65 | } | |||
| 66 | return \%results unless wantarray; | |||
| 67 | return %results; | |||
| 68 | } | |||
| 69 | ||||
| 70 | # spent 0.00002s within CGI::Cookie::get_raw_cookie which was called 2 times, avg 0.00001s/call:
# 2 times (0.00002s) by CGI::Cookie::fetch at line 41 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 0.00001s/call sub get_raw_cookie { | |||
| 71 | 6 | 4e-06 | 7e-07 | my $r = shift; |
| 72 | $r ||= eval { $MOD_PERL == 2 ? | |||
| 73 | Apache2::RequestUtil->request() : | |||
| 74 | Apache->request } if $MOD_PERL; | |||
| 75 | 4 | 4e-06 | 1e-06 | if ($r) { |
| 76 | $raw_cookie = $r->headers_in->{'Cookie'}; | |||
| 77 | } else { | |||
| 78 | if ($MOD_PERL && !exists $ENV{REQUEST_METHOD}) { | |||
| 79 | die "Run $r->subprocess_env; before calling fetch()"; | |||
| 80 | } | |||
| 81 | $raw_cookie = $ENV{HTTP_COOKIE} || $ENV{COOKIE}; | |||
| 82 | } | |||
| 83 | } | |||
| 84 | ||||
| 85 | ||||
| 86 | sub parse { | |||
| 87 | my ($self,$raw_cookie) = @_; | |||
| 88 | my %results; | |||
| 89 | ||||
| 90 | my(@pairs) = split("; ?",$raw_cookie); | |||
| 91 | foreach (@pairs) { | |||
| 92 | s/\s*(.*?)\s*/$1/; | |||
| 93 | my($key,$value) = split("=",$_,2); | |||
| 94 | ||||
| 95 | # Some foreign cookies are not in name=value format, so ignore | |||
| 96 | # them. | |||
| 97 | next if !defined($value); | |||
| 98 | my @values = (); | |||
| 99 | if ($value ne '') { | |||
| 100 | @values = map unescape($_),split(/[&;]/,$value.'&dmy'); | |||
| 101 | pop @values; | |||
| 102 | } | |||
| 103 | $key = unescape($key); | |||
| 104 | # A bug in Netscape can cause several cookies with same name to | |||
| 105 | # appear. The FIRST one in HTTP_COOKIE is the most recent version. | |||
| 106 | $results{$key} ||= $self->new(-name=>$key,-value=>\@values); | |||
| 107 | } | |||
| 108 | return \%results unless wantarray; | |||
| 109 | return %results; | |||
| 110 | } | |||
| 111 | ||||
| 112 | # spent 0.00019s within CGI::Cookie::new which was called:
# 1 times (0.00019s) by CGI::cookie at line 33 of /usr/share/perl/5.8/CGI.pm sub new { | |||
| 113 | 12 | 0.00008 | 6e-06 | my $class = shift; |
| 114 | $class = ref($class) if ref($class); | |||
| 115 | my($name,$value,$path,$domain,$secure,$expires) = # spent 0.00009s making 1 calls to CGI::Util::rearrange | |||
| 116 | rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_); | |||
| 117 | ||||
| 118 | # Pull out our parameters. | |||
| 119 | my @values; | |||
| 120 | 1 | 2e-06 | 2e-06 | if (ref($value)) { |
| 121 | if (ref($value) eq 'ARRAY') { | |||
| 122 | @values = @$value; | |||
| 123 | } elsif (ref($value) eq 'HASH') { | |||
| 124 | @values = %$value; | |||
| 125 | } | |||
| 126 | } else { | |||
| 127 | @values = ($value); | |||
| 128 | } | |||
| 129 | ||||
| 130 | bless my $self = { | |||
| 131 | 'name'=>$name, | |||
| 132 | 'value'=>[@values], | |||
| 133 | },$class; | |||
| 134 | ||||
| 135 | # IE requires the path and domain to be present for some reason. | |||
| 136 | $path ||= "/"; | |||
| 137 | # however, this breaks networks which use host tables without fully qualified | |||
| 138 | # names, so we comment it out. | |||
| 139 | # $domain = CGI::virtual_host() unless defined $domain; | |||
| 140 | ||||
| 141 | $self->path($path) if defined $path; # spent 0.00002s making 1 calls to CGI::Cookie::path | |||
| 142 | $self->domain($domain) if defined $domain; | |||
| 143 | $self->secure($secure) if defined $secure; | |||
| 144 | $self->expires($expires) if defined $expires; | |||
| 145 | # $self->max_age($expires) if defined $expires; | |||
| 146 | return $self; | |||
| 147 | } | |||
| 148 | ||||
| 149 | # spent 0.00012s within CGI::Cookie::as_string which was called:
# 1 times (0.00012s) by CGI::header at line 46 of /usr/share/perl/5.8/CGI.pm sub as_string { | |||
| 150 | 55 | 0.00025 | 5e-06 | my $self = shift; |
| 151 | return "" unless $self->name; # spent 0.00005s making 5 calls to CGI::Cookie::name, avg 0.00001s/call | |||
| 152 | ||||
| 153 | my(@constant_values,$domain,$path,$expires,$max_age,$secure); | |||
| 154 | ||||
| 155 | push(@constant_values,"domain=$domain") if $domain = $self->domain; # spent 0.00004s making 5 calls to CGI::Cookie::domain, avg 8e-06s/call | |||
| 156 | push(@constant_values,"path=$path") if $path = $self->path; # spent 0.00004s making 5 calls to CGI::Cookie::path, avg 8e-06s/call | |||
| 157 | push(@constant_values,"expires=$expires") if $expires = $self->expires; # spent 0.00004s making 5 calls to CGI::Cookie::expires, avg 9e-06s/call | |||
| 158 | push(@constant_values,"max-age=$max_age") if $max_age = $self->max_age; # spent 0.00004s making 5 calls to CGI::Cookie::max_age, avg 8e-06s/call | |||
| 159 | push(@constant_values,"secure") if $secure = $self->secure; # spent 0.00007s making 5 calls to CGI::Cookie::secure, avg 0.00001s/call | |||
| 160 | ||||
| 161 | my($key) = escape($self->name); # spent 0.00010s making 5 calls to CGI::Util::escape, avg 0.00002s/call
# spent 0.00004s making 5 calls to CGI::Cookie::name, avg 8e-06s/call | |||
| 162 | my($cookie) = join("=",($key||''),join("&",map escape($_||''),$self->value)); # spent 0.00009s making 5 calls to CGI::Util::escape, avg 0.00002s/call
# spent 0.00005s making 5 calls to CGI::Cookie::value, avg 9e-06s/call | |||
| 163 | return join("; ",$cookie,@constant_values); | |||
| 164 | } | |||
| 165 | ||||
| 166 | sub compare { | |||
| 167 | my $self = shift; | |||
| 168 | my $value = shift; | |||
| 169 | return "$self" cmp $value; | |||
| 170 | } | |||
| 171 | ||||
| 172 | # accessors | |||
| 173 | # spent 0.00009s within CGI::Cookie::name which was called 10 times, avg 9e-06s/call:
# 5 times (0.00004s) by CGI::Cookie::as_string at line 161 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 8e-06s/call
# 5 times (0.00005s) by CGI::Cookie::as_string at line 151 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 0.00001s/call sub name { | |||
| 174 | 40 | 0.00004 | 9e-07 | my $self = shift; |
| 175 | my $name = shift; | |||
| 176 | $self->{'name'} = $name if defined $name; | |||
| 177 | return $self->{'name'}; | |||
| 178 | } | |||
| 179 | ||||
| 180 | # spent 0.00005s within CGI::Cookie::value which was called 5 times, avg 9e-06s/call:
# 5 times (0.00005s) by CGI::Cookie::as_string at line 162 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 9e-06s/call sub value { | |||
| 181 | 20 | 0.00003 | 1e-06 | my $self = shift; |
| 182 | my $value = shift; | |||
| 183 | if (defined $value) { | |||
| 184 | my @values; | |||
| 185 | if (ref($value)) { | |||
| 186 | if (ref($value) eq 'ARRAY') { | |||
| 187 | @values = @$value; | |||
| 188 | } elsif (ref($value) eq 'HASH') { | |||
| 189 | @values = %$value; | |||
| 190 | } | |||
| 191 | } else { | |||
| 192 | @values = ($value); | |||
| 193 | } | |||
| 194 | $self->{'value'} = [@values]; | |||
| 195 | } | |||
| 196 | return wantarray ? @{$self->{'value'}} : $self->{'value'}->[0] | |||
| 197 | } | |||
| 198 | ||||
| 199 | # spent 0.00004s within CGI::Cookie::domain which was called 5 times, avg 8e-06s/call:
# 5 times (0.00004s) by CGI::Cookie::as_string at line 155 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 8e-06s/call sub domain { | |||
| 200 | 20 | 0.00002 | 9e-07 | my $self = shift; |
| 201 | my $domain = shift; | |||
| 202 | $self->{'domain'} = lc $domain if defined $domain; | |||
| 203 | return $self->{'domain'}; | |||
| 204 | } | |||
| 205 | ||||
| 206 | # spent 0.00007s within CGI::Cookie::secure which was called 5 times, avg 0.00001s/call:
# 5 times (0.00007s) by CGI::Cookie::as_string at line 159 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 0.00001s/call sub secure { | |||
| 207 | 20 | 0.00002 | 8e-07 | my $self = shift; |
| 208 | my $secure = shift; | |||
| 209 | $self->{'secure'} = $secure if defined $secure; | |||
| 210 | return $self->{'secure'}; | |||
| 211 | } | |||
| 212 | ||||
| 213 | # spent 0.00004s within CGI::Cookie::expires which was called 5 times, avg 9e-06s/call:
# 5 times (0.00004s) by CGI::Cookie::as_string at line 157 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 9e-06s/call sub expires { | |||
| 214 | 20 | 0.00001 | 7e-07 | my $self = shift; |
| 215 | my $expires = shift; | |||
| 216 | $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires; | |||
| 217 | return $self->{'expires'}; | |||
| 218 | } | |||
| 219 | ||||
| 220 | # spent 0.00004s within CGI::Cookie::max_age which was called 5 times, avg 8e-06s/call:
# 5 times (0.00004s) by CGI::Cookie::as_string at line 158 of /usr/share/perl/5.8/CGI/Cookie.pm, avg 8e-06s/call sub max_age { | |||
| 221 | 20 | 0.00001 | 7e-07 | my $self = shift; |
| 222 | my $expires = shift; | |||
| 223 | $self->{'max-age'} = CGI::Util::expire_calc($expires)-time() if defined $expires; | |||
| 224 | return $self->{'max-age'}; | |||
| 225 | } | |||
| 226 | ||||
| 227 | sub path { | |||
| 228 | 24 | 0.00002 | 9e-07 | my $self = shift; |
| 229 | my $path = shift; | |||
| 230 | $self->{'path'} = $path if defined $path; | |||
| 231 | return $self->{'path'}; | |||
| 232 | } | |||
| 233 | ||||
| 234 | 1 | 9e-06 | 9e-06 | 1; |
| 235 | ||||
| 236 | =head1 NAME | |||
| 237 | ||||
| 238 | CGI::Cookie - Interface to Netscape Cookies | |||
| 239 | ||||
| 240 | =head1 SYNOPSIS | |||
| 241 | ||||
| 242 | use CGI qw/:standard/; | |||
| 243 | use CGI::Cookie; | |||
| 244 | ||||
| 245 | # Create new cookies and send them | |||
| 246 | $cookie1 = new CGI::Cookie(-name=>'ID',-value=>123456); | |||
| 247 | $cookie2 = new CGI::Cookie(-name=>'preferences', | |||
| 248 | -value=>{ font => Helvetica, | |||
| 249 | size => 12 } | |||
| 250 | ); | |||
| 251 | print header(-cookie=>[$cookie1,$cookie2]); | |||
| 252 | ||||
| 253 | # fetch existing cookies | |||
| 254 | %cookies = fetch CGI::Cookie; | |||
| 255 | $id = $cookies{'ID'}->value; | |||
| 256 | ||||
| 257 | # create cookies returned from an external source | |||
| 258 | %cookies = parse CGI::Cookie($ENV{COOKIE}); | |||
| 259 | ||||
| 260 | =head1 DESCRIPTION | |||
| 261 | ||||
| 262 | CGI::Cookie is an interface to Netscape (HTTP/1.1) cookies, an | |||
| 263 | innovation that allows Web servers to store persistent information on | |||
| 264 | the browser's side of the connection. Although CGI::Cookie is | |||
| 265 | intended to be used in conjunction with CGI.pm (and is in fact used by | |||
| 266 | it internally), you can use this module independently. | |||
| 267 | ||||
| 268 | For full information on cookies see | |||
| 269 | ||||
| 270 | http://www.ics.uci.edu/pub/ietf/http/rfc2109.txt | |||
| 271 | ||||
| 272 | =head1 USING CGI::Cookie | |||
| 273 | ||||
| 274 | CGI::Cookie is object oriented. Each cookie object has a name and a | |||
| 275 | value. The name is any scalar value. The value is any scalar or | |||
| 276 | array value (associative arrays are also allowed). Cookies also have | |||
| 277 | several optional attributes, including: | |||
| 278 | ||||
| 279 | =over 4 | |||
| 280 | ||||
| 281 | =item B<1. expiration date> | |||
| 282 | ||||
| 283 | The expiration date tells the browser how long to hang on to the | |||
| 284 | cookie. If the cookie specifies an expiration date in the future, the | |||
| 285 | browser will store the cookie information in a disk file and return it | |||
| 286 | to the server every time the user reconnects (until the expiration | |||
| 287 | date is reached). If the cookie species an expiration date in the | |||
| 288 | past, the browser will remove the cookie from the disk file. If the | |||
| 289 | expiration date is not specified, the cookie will persist only until | |||
| 290 | the user quits the browser. | |||
| 291 | ||||
| 292 | =item B<2. domain> | |||
| 293 | ||||
| 294 | This is a partial or complete domain name for which the cookie is | |||
| 295 | valid. The browser will return the cookie to any host that matches | |||
| 296 | the partial domain name. For example, if you specify a domain name | |||
| 297 | of ".capricorn.com", then Netscape will return the cookie to | |||
| 298 | Web servers running on any of the machines "www.capricorn.com", | |||
| 299 | "ftp.capricorn.com", "feckless.capricorn.com", etc. Domain names | |||
| 300 | must contain at least two periods to prevent attempts to match | |||
| 301 | on top level domains like ".edu". If no domain is specified, then | |||
| 302 | the browser will only return the cookie to servers on the host the | |||
| 303 | cookie originated from. | |||
| 304 | ||||
| 305 | =item B<3. path> | |||
| 306 | ||||
| 307 | If you provide a cookie path attribute, the browser will check it | |||
| 308 | against your script's URL before returning the cookie. For example, | |||
| 309 | if you specify the path "/cgi-bin", then the cookie will be returned | |||
| 310 | to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and | |||
| 311 | "/cgi-bin/customer_service/complain.pl", but not to the script | |||
| 312 | "/cgi-private/site_admin.pl". By default, the path is set to "/", so | |||
| 313 | that all scripts at your site will receive the cookie. | |||
| 314 | ||||
| 315 | =item B<4. secure flag> | |||
| 316 | ||||
| 317 | If the "secure" attribute is set, the cookie will only be sent to your | |||
| 318 | script if the CGI request is occurring on a secure channel, such as SSL. | |||
| 319 | ||||
| 320 | =back | |||
| 321 | ||||
| 322 | =head2 Creating New Cookies | |||
| 323 | ||||
| 324 | $c = new CGI::Cookie(-name => 'foo', | |||
| 325 | -value => 'bar', | |||
| 326 | -expires => '+3M', | |||
| 327 | -domain => '.capricorn.com', | |||
| 328 | -path => '/cgi-bin/database', | |||
| 329 | -secure => 1 | |||
| 330 | ); | |||
| 331 | ||||
| 332 | Create cookies from scratch with the B<new> method. The B<-name> and | |||
| 333 | B<-value> parameters are required. The name must be a scalar value. | |||
| 334 | The value can be a scalar, an array reference, or a hash reference. | |||
| 335 | (At some point in the future cookies will support one of the Perl | |||
| 336 | object serialization protocols for full generality). | |||
| 337 | ||||
| 338 | B<-expires> accepts any of the relative or absolute date formats | |||
| 339 | recognized by CGI.pm, for example "+3M" for three months in the | |||
| 340 | future. See CGI.pm's documentation for details. | |||
| 341 | ||||
| 342 | B<-domain> points to a domain name or to a fully qualified host name. | |||
| 343 | If not specified, the cookie will be returned only to the Web server | |||
| 344 | that created it. | |||
| 345 | ||||
| 346 | B<-path> points to a partial URL on the current server. The cookie | |||
| 347 | will be returned to all URLs beginning with the specified path. If | |||
| 348 | not specified, it defaults to '/', which returns the cookie to all | |||
| 349 | pages at your site. | |||
| 350 | ||||
| 351 | B<-secure> if set to a true value instructs the browser to return the | |||
| 352 | cookie only when a cryptographic protocol is in use. | |||
| 353 | ||||
| 354 | =head2 Sending the Cookie to the Browser | |||
| 355 | ||||
| 356 | Within a CGI script you can send a cookie to the browser by creating | |||
| 357 | one or more Set-Cookie: fields in the HTTP header. Here is a typical | |||
| 358 | sequence: | |||
| 359 | ||||
| 360 | my $c = new CGI::Cookie(-name => 'foo', | |||
| 361 | -value => ['bar','baz'], | |||
| 362 | -expires => '+3M'); | |||
| 363 | ||||
| 364 | print "Set-Cookie: $c\n"; | |||
| 365 | print "Content-Type: text/html\n\n"; | |||
| 366 | ||||
| 367 | To send more than one cookie, create several Set-Cookie: fields. | |||
| 368 | ||||
| 369 | If you are using CGI.pm, you send cookies by providing a -cookie | |||
| 370 | argument to the header() method: | |||
| 371 | ||||
| 372 | print header(-cookie=>$c); | |||
| 373 | ||||
| 374 | Mod_perl users can set cookies using the request object's header_out() | |||
| 375 | method: | |||
| 376 | ||||
| 377 | $r->headers_out->set('Set-Cookie' => $c); | |||
| 378 | ||||
| 379 | Internally, Cookie overloads the "" operator to call its as_string() | |||
| 380 | method when incorporated into the HTTP header. as_string() turns the | |||
| 381 | Cookie's internal representation into an RFC-compliant text | |||
| 382 | representation. You may call as_string() yourself if you prefer: | |||
| 383 | ||||
| 384 | print "Set-Cookie: ",$c->as_string,"\n"; | |||
| 385 | ||||
| 386 | =head2 Recovering Previous Cookies | |||
| 387 | ||||
| 388 | %cookies = fetch CGI::Cookie; | |||
| 389 | ||||
| 390 | B<fetch> returns an associative array consisting of all cookies | |||
| 391 | returned by the browser. The keys of the array are the cookie names. You | |||
| 392 | can iterate through the cookies this way: | |||
| 393 | ||||
| 394 | %cookies = fetch CGI::Cookie; | |||
| 395 | foreach (keys %cookies) { | |||
| 396 | do_something($cookies{$_}); | |||
| 397 | } | |||
| 398 | ||||
| 399 | In a scalar context, fetch() returns a hash reference, which may be more | |||
| 400 | efficient if you are manipulating multiple cookies. | |||
| 401 | ||||
| 402 | CGI.pm uses the URL escaping methods to save and restore reserved characters | |||
| 403 | in its cookies. If you are trying to retrieve a cookie set by a foreign server, | |||
| 404 | this escaping method may trip you up. Use raw_fetch() instead, which has the | |||
| 405 | same semantics as fetch(), but performs no unescaping. | |||
| 406 | ||||
| 407 | You may also retrieve cookies that were stored in some external | |||
| 408 | form using the parse() class method: | |||
| 409 | ||||
| 410 | $COOKIES = `cat /usr/tmp/Cookie_stash`; | |||
| 411 | %cookies = parse CGI::Cookie($COOKIES); | |||
| 412 | ||||
| 413 | If you are in a mod_perl environment, you can save some overhead by | |||
| 414 | passing the request object to fetch() like this: | |||
| 415 | ||||
| 416 | CGI::Cookie->fetch($r); | |||
| 417 | ||||
| 418 | =head2 Manipulating Cookies | |||
| 419 | ||||
| 420 | Cookie objects have a series of accessor methods to get and set cookie | |||
| 421 | attributes. Each accessor has a similar syntax. Called without | |||
| 422 | arguments, the accessor returns the current value of the attribute. | |||
| 423 | Called with an argument, the accessor changes the attribute and | |||
| 424 | returns its new value. | |||
| 425 | ||||
| 426 | =over 4 | |||
| 427 | ||||
| 428 | =item B<name()> | |||
| 429 | ||||
| 430 | Get or set the cookie's name. Example: | |||
| 431 | ||||
| 432 | $name = $c->name; | |||
| 433 | $new_name = $c->name('fred'); | |||
| 434 | ||||
| 435 | =item B<value()> | |||
| 436 | ||||
| 437 | Get or set the cookie's value. Example: | |||
| 438 | ||||
| 439 | $value = $c->value; | |||
| 440 | @new_value = $c->value(['a','b','c','d']); | |||
| 441 | ||||
| 442 | B<value()> is context sensitive. In a list context it will return | |||
| 443 | the current value of the cookie as an array. In a scalar context it | |||
| 444 | will return the B<first> value of a multivalued cookie. | |||
| 445 | ||||
| 446 | =item B<domain()> | |||
| 447 | ||||
| 448 | Get or set the cookie's domain. | |||
| 449 | ||||
| 450 | =item B<path()> | |||
| 451 | ||||
| 452 | Get or set the cookie's path. | |||
| 453 | ||||
| 454 | =item B<expires()> | |||
| 455 | ||||
| 456 | Get or set the cookie's expiration time. | |||
| 457 | ||||
| 458 | =back | |||
| 459 | ||||
| 460 | ||||
| 461 | =head1 AUTHOR INFORMATION | |||
| 462 | ||||
| 463 | Copyright 1997-1998, Lincoln D. Stein. All rights reserved. | |||
| 464 | ||||
| 465 | This library is free software; you can redistribute it and/or modify | |||
| 466 | it under the same terms as Perl itself. | |||
| 467 | ||||
| 468 | Address bug reports and comments to: lstein@cshl.org | |||
| 469 | ||||
| 470 | =head1 BUGS | |||
| 471 | ||||
| 472 | This section intentionally left blank. | |||
| 473 | ||||
| 474 | =head1 SEE ALSO | |||
| 475 | ||||
| 476 | L<CGI::Carp>, L<CGI> | |||
| 477 | ||||
| 478 | =cut |