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