# documentation in manual or html file format (these utilities are part of the
# Perl 5 distribution).
-# Copyright 1995,1996, Lincoln D. Stein. All rights reserved.
+# Copyright 1995-1999, Lincoln D. Stein. All rights reserved.
# It may be used and modified freely, but I do request that this copyright
# notice remain attached to the file. You may modify this module as you
# wish, but if you redistribute a modified version, please attach a note
# listing the modifications you have made.
-# The most recent version and complete docs are available at:
-# http://www.genome.wi.mit.edu/ftp/pub/software/WWW/cgi_docs.html
-# ftp://ftp-genome.wi.mit.edu/pub/software/WWW/
+$CGI::Cookie::VERSION='1.16';
-$CGI::Cookie::VERSION='1.06';
-
-use CGI;
+use CGI::Util qw(rearrange unescape escape);
use overload '""' => \&as_string,
'cmp' => \&compare,
'fallback'=>1;
my %results;
my($key,$value);
- my(@pairs) = split("; ",$raw_cookie);
+ my(@pairs) = split("; ?",$raw_cookie);
foreach (@pairs) {
- if (/^([^=]+)=(.*)/) {
- $key = $1;
- $value = $2;
- }
- else {
- $key = $_;
- $value = '';
- }
- $results{$key} = $value;
+ s/\s*(.*?)\s*/$1/;
+ if (/^([^=]+)=(.*)/) {
+ $key = $1;
+ $value = $2;
+ }
+ else {
+ $key = $_;
+ $value = '';
+ }
+ $results{$key} = $value;
}
return \%results unless wantarray;
return %results;
my ($self,$raw_cookie) = @_;
my %results;
- my(@pairs) = split("; ",$raw_cookie);
+ my(@pairs) = split("; ?",$raw_cookie);
foreach (@pairs) {
- my($key,$value) = split("=");
- my(@values) = map CGI::unescape($_),split('&',$value);
- $key = CGI::unescape($key);
- # A bug in Netscape can cause several cookies with same name to
- # appear. The FIRST one in HTTP_COOKIE is the most recent version.
- $results{$key} ||= $self->new(-name=>$key,-value=>\@values);
+ s/\s*(.*?)\s*/$1/;
+ my($key,$value) = split("=");
+ my(@values) = map unescape($_),split('&',$value);
+ $key = unescape($key);
+ # Some foreign cookies are not in name=value format, so ignore
+ # them.
+ next if !defined($value);
+ # A bug in Netscape can cause several cookies with same name to
+ # appear. The FIRST one in HTTP_COOKIE is the most recent version.
+ $results{$key} ||= $self->new(-name=>$key,-value=>\@values);
}
return \%results unless wantarray;
return %results;
my $class = shift;
$class = ref($class) if ref($class);
my($name,$value,$path,$domain,$secure,$expires) =
- CGI->rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
+ rearrange([NAME,[VALUE,VALUES],PATH,DOMAIN,SECURE,EXPIRES],@_);
# Pull out our parameters.
my @values;
'value'=>[@values],
},$class;
- # IE requires the path to be present for some reason.
- ($path = $ENV{'SCRIPT_NAME'})=~s![^/]+$!! unless $path;
+ # IE requires the path and domain to be present for some reason.
+ $path ||= '/';
+# however, this breaks networks which use host tables without fully qualified
+# names, so we comment it out.
+# $domain = CGI::virtual_host() unless defined $domain;
- $self->path($path) if defined $path;
+ $self->path($path) if defined $path;
$self->domain($domain) if defined $domain;
$self->secure($secure) if defined $secure;
$self->expires($expires) if defined $expires;
push(@constant_values,"expires=$expires") if $expires = $self->expires;
push(@constant_values,'secure') if $secure = $self->secure;
- my($key) = CGI::escape($self->name);
- my($cookie) = join("=",$key,join("&",map CGI::escape($_),$self->value));
+ my($key) = escape($self->name);
+ my($cookie) = join("=",$key,join("&",map escape($_),$self->value));
return join("; ",$cookie,@constant_values);
}
sub expires {
my $self = shift;
my $expires = shift;
- $self->{'expires'} = CGI::expires($expires,'cookie') if defined $expires;
+ $self->{'expires'} = CGI::Util::expires($expires,'cookie') if defined $expires;
return $self->{'expires'};
}
If you provide a cookie path attribute, the browser will check it
against your script's URL before returning the cookie. For example,
if you specify the path "/cgi-bin", then the cookie will be returned
-to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl",
-and "/cgi-bin/customer_service/complain.pl", but not to the script
-"/cgi-private/site_admin.pl". By default, path is set to "/", which
-causes the cookie to be sent to any CGI script on your site.
+to each of the scripts "/cgi-bin/tally.pl", "/cgi-bin/order.pl", and
+"/cgi-bin/customer_service/complain.pl", but not to the script
+"/cgi-private/site_admin.pl". By default, the path is set to "/", so
+that all scripts at your site will receive the cookie.
=item B<4. secure flag>
In a scalar context, fetch() returns a hash reference, which may be more
efficient if you are manipulating multiple cookies.
-
+
CGI.pm uses the URL escaping methods to save and restore reserved characters
in its cookies. If you are trying to retrieve a cookie set by a foreign server,
this escaping method may trip you up. Use raw_fetch() instead, which has the
$value = $c->value;
@new_value = $c->value(['a','b','c','d']);
-B<value()> is context sensitive. In an array context it will return
+B<value()> is context sensitive. In a list context it will return
the current value of the cookie as an array. In a scalar context it
will return the B<first> value of a multivalued cookie.
=head1 SEE ALSO
L<CGI::Carp>, L<CGI>
-
+
=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff