HTTP-Cookies-6.01HEADHTTP-Cookies-6.01master

9 files changed, 2181 insertions, 0 deletions

diff --git a/Changes b/Changes
new file mode 100644
index 0000000..ea8259a
--- /dev/null
+++ b/Changes
@@ -0,0 +1,14 @@
+_______________________________________________________________________________
+2011-02-15 HTTP-Cookies 6.01
+
+Restore 5.8.1 compatiblity.
+
+
+
+_______________________________________________________________________________
+2011-02-27 HTTP-Cookies 6.00
+
+Initial release of HTTP-Cookies as a separate distribution. There are no code
+changes besides incrementing the version number since libwww-perl-5.837.
+
+The HTTP::Cookies module used to be bundled with the libwww-perl distribution.
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..f79c868
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,9 @@
+Changes
+lib/HTTP/Cookies.pm
+lib/HTTP/Cookies/Microsoft.pm
+lib/HTTP/Cookies/Netscape.pm
+Makefile.PL
+MANIFEST			This list of files
+README
+t/cookies.t
+META.yml                                 Module meta-data (added by MakeMaker)
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..34a9aee
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,28 @@
+--- #YAML:1.0
+name:               HTTP-Cookies
+version:            6.01
+abstract:           HTTP cookie jars
+author:
+    - Gisle Aas <gisle@activestate.com>
+license:            perl
+distribution_type:  module
+configure_requires:
+    ExtUtils::MakeMaker:  0
+build_requires:
+    ExtUtils::MakeMaker:  0
+requires:
+    HTTP::Date:           6
+    HTTP::Headers::Util:  6
+    perl:                 5.008001
+    Time::Local:          0
+resources:
+    MailingList:  mailto:libwww@perl.org
+    repository:   http://github.com/gisle/http-cookies
+no_index:
+    directory:
+        - t
+        - inc
+generated_by:       ExtUtils::MakeMaker version 6.57_05
+meta-spec:
+    url:      http://module-build.sourceforge.net/META-spec-v1.4.html
+    version:  1.4
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..e868855
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,48 @@
+#!perl -w
+
+require 5.008001;
+use strict;
+use ExtUtils::MakeMaker;
+
+WriteMakefile(
+    NAME => 'HTTP::Cookies',
+    VERSION_FROM => 'lib/HTTP/Cookies.pm',
+    ABSTRACT_FROM => 'lib/HTTP/Cookies.pm',
+    AUTHOR => 'Gisle Aas <gisle@activestate.com>',
+    LICENSE => "perl",
+    MIN_PERL_VERSION => 5.008001,
+    PREREQ_PM => {
+	'HTTP::Date' => 6,
+	'HTTP::Headers::Util' => 6,
+	'Time::Local' => 0,
+    },
+    META_MERGE => {
+	resources => {
+            repository => 'http://github.com/gisle/http-cookies',
+	    MailingList => 'mailto:libwww@perl.org',
+        }
+    },
+);
+
+
+BEGIN {
+    # compatibility with older versions of MakeMaker
+    my $developer = -f ".gitignore";
+    my %mm_req = (
+        LICENCE => 6.31,
+        META_MERGE => 6.45,
+        META_ADD => 6.45,
+        MIN_PERL_VERSION => 6.48,
+    );
+    undef(*WriteMakefile);
+    *WriteMakefile = sub {
+        my %arg = @_;
+        for (keys %mm_req) {
+            unless (eval { ExtUtils::MakeMaker->VERSION($mm_req{$_}) }) {
+                warn "$_ $@" if $developer;
+                delete $arg{$_};
+            }
+        }
+        ExtUtils::MakeMaker::WriteMakefile(%arg);
+    };
+}
diff --git a/README b/README
new file mode 100644
index 0000000..711913c
--- /dev/null
+++ b/README
@@ -0,0 +1,152 @@
+NAME
+    HTTP::Cookies - HTTP cookie jars
+
+SYNOPSIS
+      use HTTP::Cookies;
+      $cookie_jar = HTTP::Cookies->new(
+        file => "$ENV{'HOME'}/lwp_cookies.dat",
+        autosave => 1,
+      );
+
+      use LWP;
+      my $browser = LWP::UserAgent->new;
+      $browser->cookie_jar($cookie_jar);
+
+    Or for an empty and temporary cookie jar:
+
+      use LWP;
+      my $browser = LWP::UserAgent->new;
+      $browser->cookie_jar( {} );
+
+DESCRIPTION
+    This class is for objects that represent a "cookie jar" -- that is, a
+    database of all the HTTP cookies that a given LWP::UserAgent object
+    knows about.
+
+    Cookies are a general mechanism which server side connections can use to
+    both store and retrieve information on the client side of the
+    connection. For more information about cookies refer to
+    <URL:http://curl.haxx.se/rfc/cookie_spec.html> and
+    <URL:http://www.cookiecentral.com/>. This module also implements the new
+    style cookies described in *RFC 2965*. The two variants of cookies are
+    supposed to be able to coexist happily.
+
+    Instances of the class *HTTP::Cookies* are able to store a collection of
+    Set-Cookie2: and Set-Cookie: headers and are able to use this
+    information to initialize Cookie-headers in *HTTP::Request* objects. The
+    state of a *HTTP::Cookies* object can be saved in and restored from
+    files.
+
+METHODS
+    The following methods are provided:
+
+    $cookie_jar = HTTP::Cookies->new
+        The constructor takes hash style parameters. The following
+        parameters are recognized:
+
+          file:            name of the file to restore cookies from and save cookies to
+          autosave:        save during destruction (bool)
+          ignore_discard:  save even cookies that are requested to be discarded (bool)
+          hide_cookie2:    do not add Cookie2 header to requests
+
+        Future parameters might include (not yet implemented):
+
+          max_cookies               300
+          max_cookies_per_domain    20
+          max_cookie_size           4096
+
+          no_cookies   list of domain names that we never return cookies to
+
+    $cookie_jar->add_cookie_header( $request )
+        The add_cookie_header() method will set the appropriate
+        Cookie:-header for the *HTTP::Request* object given as argument. The
+        $request must have a valid url attribute before this method is
+        called.
+
+    $cookie_jar->extract_cookies( $response )
+        The extract_cookies() method will look for Set-Cookie: and
+        Set-Cookie2: headers in the *HTTP::Response* object passed as
+        argument. Any of these headers that are found are used to update the
+        state of the $cookie_jar.
+
+    $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port,
+    $path_spec, $secure, $maxage, $discard, \%rest )
+        The set_cookie() method updates the state of the $cookie_jar. The
+        $key, $val, $domain, $port and $path arguments are strings. The
+        $path_spec, $secure, $discard arguments are boolean values. The
+        $maxage value is a number indicating number of seconds that this
+        cookie will live. A value <= 0 will delete this cookie. %rest
+        defines various other attributes like "Comment" and "CommentURL".
+
+    $cookie_jar->save
+    $cookie_jar->save( $file )
+        This method file saves the state of the $cookie_jar to a file. The
+        state can then be restored later using the load() method. If a
+        filename is not specified we will use the name specified during
+        construction. If the attribute *ignore_discard* is set, then we will
+        even save cookies that are marked to be discarded.
+
+        The default is to save a sequence of "Set-Cookie3" lines.
+        "Set-Cookie3" is a proprietary LWP format, not known to be
+        compatible with any browser. The *HTTP::Cookies::Netscape* sub-class
+        can be used to save in a format compatible with Netscape.
+
+    $cookie_jar->load
+    $cookie_jar->load( $file )
+        This method reads the cookies from the file and adds them to the
+        $cookie_jar. The file must be in the format written by the save()
+        method.
+
+    $cookie_jar->revert
+        This method empties the $cookie_jar and re-loads the $cookie_jar
+        from the last save file.
+
+    $cookie_jar->clear
+    $cookie_jar->clear( $domain )
+    $cookie_jar->clear( $domain, $path )
+    $cookie_jar->clear( $domain, $path, $key )
+        Invoking this method without arguments will empty the whole
+        $cookie_jar. If given a single argument only cookies belonging to
+        that domain will be removed. If given two arguments, cookies
+        belonging to the specified path within that domain are removed. If
+        given three arguments, then the cookie with the specified key, path
+        and domain is removed.
+
+    $cookie_jar->clear_temporary_cookies
+        Discard all temporary cookies. Scans for all cookies in the jar with
+        either no expire field or a true `discard' flag. To be called when
+        the user agent shuts down according to RFC 2965.
+
+    $cookie_jar->scan( \&callback )
+        The argument is a subroutine that will be invoked for each cookie
+        stored in the $cookie_jar. The subroutine will be invoked with the
+        following arguments:
+
+          0  version
+          1  key
+          2  val
+          3  path
+          4  domain
+          5  port
+          6  path_spec
+          7  secure
+          8  expires
+          9  discard
+         10  hash
+
+    $cookie_jar->as_string
+    $cookie_jar->as_string( $skip_discardables )
+        The as_string() method will return the state of the $cookie_jar
+        represented as a sequence of "Set-Cookie3" header lines separated by
+        "\n". If $skip_discardables is TRUE, it will not return lines for
+        cookies with the *Discard* attribute.
+
+SEE ALSO
+    HTTP::Cookies::Netscape, HTTP::Cookies::Microsoft
+
+COPYRIGHT
+    Copyright 1997-2002 Gisle Aas
+
+    This library is free software; you can redistribute it and/or modify it
+    under the same terms as Perl itself.
+
diff --git a/lib/HTTP/Cookies.pm b/lib/HTTP/Cookies.pm
new file mode 100644
index 0000000..79ac4f2
--- /dev/null
+++ b/lib/HTTP/Cookies.pm
@@ -0,0 +1,781 @@
+package HTTP::Cookies;
+
+use strict;
+use HTTP::Date qw(str2time parse_date time2str);
+use HTTP::Headers::Util qw(_split_header_words join_header_words);
+
+use vars qw($VERSION $EPOCH_OFFSET);
+$VERSION = "6.01";
+
+# Legacy: because "use "HTTP::Cookies" used be the ONLY way
+#  to load the class HTTP::Cookies::Netscape.
+require HTTP::Cookies::Netscape;
+
+$EPOCH_OFFSET = 0;  # difference from Unix epoch
+if ($^O eq "MacOS") {
+    require Time::Local;
+    $EPOCH_OFFSET = Time::Local::timelocal(0,0,0,1,0,70);
+}
+
+# A HTTP::Cookies object is a hash.  The main attribute is the
+# COOKIES 3 level hash:  $self->{COOKIES}{$domain}{$path}{$key}.
+
+sub new
+{
+    my $class = shift;
+    my $self = bless {
+	COOKIES => {},
+    }, $class;
+    my %cnf = @_;
+    for (keys %cnf) {
+	$self->{lc($_)} = $cnf{$_};
+    }
+    $self->load;
+    $self;
+}
+
+
+sub add_cookie_header
+{
+    my $self = shift;
+    my $request = shift || return;
+    my $url = $request->uri;
+    my $scheme = $url->scheme;
+    unless ($scheme =~ /^https?\z/) {
+	return;
+    }
+
+    my $domain = _host($request, $url);
+    $domain = "$domain.local" unless $domain =~ /\./;
+    my $secure_request = ($scheme eq "https");
+    my $req_path = _url_path($url);
+    my $req_port = $url->port;
+    my $now = time();
+    _normalize_path($req_path) if $req_path =~ /%/;
+
+    my @cval;    # cookie values for the "Cookie" header
+    my $set_ver;
+    my $netscape_only = 0; # An exact domain match applies to any cookie
+
+    while ($domain =~ /\./) {
+        # Checking $domain for cookies"
+	my $cookies = $self->{COOKIES}{$domain};
+	next unless $cookies;
+	if ($self->{delayload} && defined($cookies->{'//+delayload'})) {
+	    my $cookie_data = $cookies->{'//+delayload'}{'cookie'};
+	    delete $self->{COOKIES}{$domain};
+	    $self->load_cookie($cookie_data->[1]);
+	    $cookies = $self->{COOKIES}{$domain};
+	    next unless $cookies;  # should not really happen
+	}
+
+	# Want to add cookies corresponding to the most specific paths
+	# first (i.e. longest path first)
+	my $path;
+	for $path (sort {length($b) <=> length($a) } keys %$cookies) {
+	    if (index($req_path, $path) != 0) {
+		next;
+	    }
+
+	    my($key,$array);
+	    while (($key,$array) = each %{$cookies->{$path}}) {
+		my($version,$val,$port,$path_spec,$secure,$expires) = @$array;
+		if ($secure && !$secure_request) {
+		    next;
+		}
+		if ($expires && $expires < $now) {
+		    next;
+		}
+		if ($port) {
+		    my $found;
+		    if ($port =~ s/^_//) {
+			# The corresponding Set-Cookie attribute was empty
+			$found++ if $port eq $req_port;
+			$port = "";
+		    }
+		    else {
+			my $p;
+			for $p (split(/,/, $port)) {
+			    $found++, last if $p eq $req_port;
+			}
+		    }
+		    unless ($found) {
+			next;
+		    }
+		}
+		if ($version > 0 && $netscape_only) {
+		    next;
+		}
+
+		# set version number of cookie header.
+	        # XXX: What should it be if multiple matching
+                #      Set-Cookie headers have different versions themselves
+		if (!$set_ver++) {
+		    if ($version >= 1) {
+			push(@cval, "\$Version=$version");
+		    }
+		    elsif (!$self->{hide_cookie2}) {
+			$request->header(Cookie2 => '$Version="1"');
+		    }
+		}
+
+		# do we need to quote the value
+		if ($val =~ /\W/ && $version) {
+		    $val =~ s/([\\\"])/\\$1/g;
+		    $val = qq("$val");
+		}
+
+		# and finally remember this cookie
+		push(@cval, "$key=$val");
+		if ($version >= 1) {
+		    push(@cval, qq(\$Path="$path"))     if $path_spec;
+		    push(@cval, qq(\$Domain="$domain")) if $domain =~ /^\./;
+		    if (defined $port) {
+			my $p = '$Port';
+			$p .= qq(="$port") if length $port;
+			push(@cval, $p);
+		    }
+		}
+
+	    }
+        }
+
+    } continue {
+	# Try with a more general domain, alternately stripping
+	# leading name components and leading dots.  When this
+	# results in a domain with no leading dot, it is for
+	# Netscape cookie compatibility only:
+	#
+	# a.b.c.net	Any cookie
+	# .b.c.net	Any cookie
+	# b.c.net	Netscape cookie only
+	# .c.net	Any cookie
+
+	if ($domain =~ s/^\.+//) {
+	    $netscape_only = 1;
+	}
+	else {
+	    $domain =~ s/[^.]*//;
+	    $netscape_only = 0;
+	}
+    }
+
+    if (@cval) {
+	if (my $old = $request->header("Cookie")) {
+	    unshift(@cval, $old);
+	}
+	$request->header(Cookie => join("; ", @cval));
+    }
+
+    $request;
+}
+
+
+sub extract_cookies
+{
+    my $self = shift;
+    my $response = shift || return;
+
+    my @set = _split_header_words($response->_header("Set-Cookie2"));
+    my @ns_set = $response->_header("Set-Cookie");
+
+    return $response unless @set || @ns_set;  # quick exit
+
+    my $request = $response->request;
+    my $url = $request->uri;
+    my $req_host = _host($request, $url);
+    $req_host = "$req_host.local" unless $req_host =~ /\./;
+    my $req_port = $url->port;
+    my $req_path = _url_path($url);
+    _normalize_path($req_path) if $req_path =~ /%/;
+
+    if (@ns_set) {
+	# The old Netscape cookie format for Set-Cookie
+	# http://curl.haxx.se/rfc/cookie_spec.html
+	# can for instance contain an unquoted "," in the expires
+	# field, so we have to use this ad-hoc parser.
+	my $now = time();
+
+	# Build a hash of cookies that was present in Set-Cookie2
+	# headers.  We need to skip them if we also find them in a
+	# Set-Cookie header.
+	my %in_set2;
+	for (@set) {
+	    $in_set2{$_->[0]}++;
+	}
+
+	my $set;
+	for $set (@ns_set) {
+            $set =~ s/^\s+//;
+	    my @cur;
+	    my $param;
+	    my $expires;
+	    my $first_param = 1;
+	    for $param (split(/;\s*/, $set)) {
+                next unless length($param);
+		my($k,$v) = split(/\s*=\s*/, $param, 2);
+		if (defined $v) {
+		    $v =~ s/\s+$//;
+		    #print "$k => $v\n";
+		}
+		else {
+		    $k =~ s/\s+$//;
+		    #print "$k => undef";
+		}
+		if (!$first_param && lc($k) eq "expires") {
+		    my $etime = str2time($v);
+		    if (defined $etime) {
+			push(@cur, "Max-Age" => $etime - $now);
+			$expires++;
+		    }
+		    else {
+			# parse_date can deal with years outside the range of time_t,
+			my($year, $mon, $day, $hour, $min, $sec, $tz) = parse_date($v);
+			if ($year) {
+			    my $thisyear = (gmtime)[5] + 1900;
+			    if ($year < $thisyear) {
+				push(@cur, "Max-Age" => -1);  # any negative value will do
+				$expires++;
+			    }
+			    elsif ($year >= $thisyear + 10) {
+				# the date is at least 10 years into the future, just replace
+				# it with something approximate
+				push(@cur, "Max-Age" => 10 * 365 * 24 * 60 * 60);
+				$expires++;
+			    }
+			}
+		    }
+		}
+                elsif (!$first_param && lc($k) =~ /^(?:version|discard|ns-cookie)/) {
+                    # ignore
+                }
+		else {
+		    push(@cur, $k => $v);
+		}
+		$first_param = 0;
+	    }
+            next unless @cur;
+	    next if $in_set2{$cur[0]};
+
+#	    push(@cur, "Port" => $req_port);
+	    push(@cur, "Discard" => undef) unless $expires;
+	    push(@cur, "Version" => 0);
+	    push(@cur, "ns-cookie" => 1);
+	    push(@set, \@cur);
+	}
+    }
+
+  SET_COOKIE:
+    for my $set (@set) {
+	next unless @$set >= 2;
+
+	my $key = shift @$set;
+	my $val = shift @$set;
+
+	my %hash;
+	while (@$set) {
+	    my $k = shift @$set;
+	    my $v = shift @$set;
+	    my $lc = lc($k);
+	    # don't loose case distinction for unknown fields
+	    $k = $lc if $lc =~ /^(?:discard|domain|max-age|
+                                    path|port|secure|version)$/x;
+	    if ($k eq "discard" || $k eq "secure") {
+		$v = 1 unless defined $v;
+	    }
+	    next if exists $hash{$k};  # only first value is significant
+	    $hash{$k} = $v;
+	};
+
+	my %orig_hash = %hash;
+	my $version   = delete $hash{version};
+	$version = 1 unless defined($version);
+	my $discard   = delete $hash{discard};
+	my $secure    = delete $hash{secure};
+	my $maxage    = delete $hash{'max-age'};
+	my $ns_cookie = delete $hash{'ns-cookie'};
+
+	# Check domain
+	my $domain  = delete $hash{domain};
+	$domain = lc($domain) if defined $domain;
+	if (defined($domain)
+	    && $domain ne $req_host && $domain ne ".$req_host") {
+	    if ($domain !~ /\./ && $domain ne "local") {
+		next SET_COOKIE;
+	    }
+	    $domain = ".$domain" unless $domain =~ /^\./;
+	    if ($domain =~ /\.\d+$/) {
+		next SET_COOKIE;
+	    }
+	    my $len = length($domain);
+	    unless (substr($req_host, -$len) eq $domain) {
+		next SET_COOKIE;
+	    }
+	    my $hostpre = substr($req_host, 0, length($req_host) - $len);
+	    if ($hostpre =~ /\./ && !$ns_cookie) {
+		next SET_COOKIE;
+	    }
+	}
+	else {
+	    $domain = $req_host;
+	}
+
+	my $path = delete $hash{path};
+	my $path_spec;
+	if (defined $path && $path ne '') {
+	    $path_spec++;
+	    _normalize_path($path) if $path =~ /%/;
+	    if (!$ns_cookie &&
+                substr($req_path, 0, length($path)) ne $path) {
+		next SET_COOKIE;
+	    }
+	}
+	else {
+	    $path = $req_path;
+	    $path =~ s,/[^/]*$,,;
+	    $path = "/" unless length($path);
+	}
+
+	my $port;
+	if (exists $hash{port}) {
+	    $port = delete $hash{port};
+	    if (defined $port) {
+		$port =~ s/\s+//g;
+		my $found;
+		for my $p (split(/,/, $port)) {
+		    unless ($p =~ /^\d+$/) {
+			next SET_COOKIE;
+		    }
+		    $found++ if $p eq $req_port;
+		}
+		unless ($found) {
+		    next SET_COOKIE;
+		}
+	    }
+	    else {
+		$port = "_$req_port";
+	    }
+	}
+	$self->set_cookie($version,$key,$val,$path,$domain,$port,$path_spec,$secure,$maxage,$discard, \%hash)
+	    if $self->set_cookie_ok(\%orig_hash);
+    }
+
+    $response;
+}
+
+sub set_cookie_ok
+{
+    1;
+}
+
+
+sub set_cookie
+{
+    my $self = shift;
+    my($version,
+       $key, $val, $path, $domain, $port,
+       $path_spec, $secure, $maxage, $discard, $rest) = @_;
+
+    # path and key can not be empty (key can't start with '$')
+    return $self if !defined($path) || $path !~ m,^/, ||
+	            !defined($key)  || $key  =~ m,^\$,;
+
+    # ensure legal port
+    if (defined $port) {
+	return $self unless $port =~ /^_?\d+(?:,\d+)*$/;
+    }
+
+    my $expires;
+    if (defined $maxage) {
+	if ($maxage <= 0) {
+	    delete $self->{COOKIES}{$domain}{$path}{$key};
+	    return $self;
+	}
+	$expires = time() + $maxage;
+    }
+    $version = 0 unless defined $version;
+
+    my @array = ($version, $val,$port,
+		 $path_spec,
+		 $secure, $expires, $discard);
+    push(@array, {%$rest}) if defined($rest) && %$rest;
+    # trim off undefined values at end
+    pop(@array) while !defined $array[-1];
+
+    $self->{COOKIES}{$domain}{$path}{$key} = \@array;
+    $self;
+}
+
+
+sub save
+{
+    my $self = shift;
+    my $file = shift || $self->{'file'} || return;
+    local(*FILE);
+    open(FILE, ">$file") or die "Can't open $file: $!";
+    print FILE "#LWP-Cookies-1.0\n";
+    print FILE $self->as_string(!$self->{ignore_discard});
+    close(FILE);
+    1;
+}
+
+
+sub load
+{
+    my $self = shift;
+    my $file = shift || $self->{'file'} || return;
+    local(*FILE, $_);
+    local $/ = "\n";  # make sure we got standard record separator
+    open(FILE, $file) or return;
+    my $magic = <FILE>;
+    unless ($magic =~ /^\#LWP-Cookies-(\d+\.\d+)/) {
+	warn "$file does not seem to contain cookies";
+	return;
+    }
+    while (<FILE>) {
+	next unless s/^Set-Cookie3:\s*//;
+	chomp;
+	my $cookie;
+	for $cookie (_split_header_words($_)) {
+	    my($key,$val) = splice(@$cookie, 0, 2);
+	    my %hash;
+	    while (@$cookie) {
+		my $k = shift @$cookie;
+		my $v = shift @$cookie;
+		$hash{$k} = $v;
+	    }
+	    my $version   = delete $hash{version};
+	    my $path      = delete $hash{path};
+	    my $domain    = delete $hash{domain};
+	    my $port      = delete $hash{port};
+	    my $expires   = str2time(delete $hash{expires});
+
+	    my $path_spec = exists $hash{path_spec}; delete $hash{path_spec};
+	    my $secure    = exists $hash{secure};    delete $hash{secure};
+	    my $discard   = exists $hash{discard};   delete $hash{discard};
+
+	    my @array =	($version,$val,$port,
+			 $path_spec,$secure,$expires,$discard);
+	    push(@array, \%hash) if %hash;
+	    $self->{COOKIES}{$domain}{$path}{$key} = \@array;
+	}
+    }
+    close(FILE);
+    1;
+}
+
+
+sub revert
+{
+    my $self = shift;
+    $self->clear->load;
+    $self;
+}
+
+
+sub clear
+{
+    my $self = shift;
+    if (@_ == 0) {
+	$self->{COOKIES} = {};
+    }
+    elsif (@_ == 1) {
+	delete $self->{COOKIES}{$_[0]};
+    }
+    elsif (@_ == 2) {
+	delete $self->{COOKIES}{$_[0]}{$_[1]};
+    }
+    elsif (@_ == 3) {
+	delete $self->{COOKIES}{$_[0]}{$_[1]}{$_[2]};
+    }
+    else {
+	require Carp;
+        Carp::carp('Usage: $c->clear([domain [,path [,key]]])');
+    }
+    $self;
+}
+
+
+sub clear_temporary_cookies
+{
+    my($self) = @_;
+
+    $self->scan(sub {
+        if($_[9] or        # "Discard" flag set
+           not $_[8]) {    # No expire field?
+            $_[8] = -1;            # Set the expire/max_age field
+            $self->set_cookie(@_); # Clear the cookie
+        }
+      });
+}
+
+
+sub DESTROY
+{
+    my $self = shift;
+    local($., $@, $!, $^E, $?);
+    $self->save if $self->{'autosave'};
+}
+
+
+sub scan
+{
+    my($self, $cb) = @_;
+    my($domain,$path,$key);
+    for $domain (sort keys %{$self->{COOKIES}}) {
+	for $path (sort keys %{$self->{COOKIES}{$domain}}) {
+	    for $key (sort keys %{$self->{COOKIES}{$domain}{$path}}) {
+		my($version,$val,$port,$path_spec,
+		   $secure,$expires,$discard,$rest) =
+		       @{$self->{COOKIES}{$domain}{$path}{$key}};
+		$rest = {} unless defined($rest);
+		&$cb($version,$key,$val,$path,$domain,$port,
+		     $path_spec,$secure,$expires,$discard,$rest);
+	    }
+	}
+    }
+}
+
+
+sub as_string
+{
+    my($self, $skip_discard) = @_;
+    my @res;
+    $self->scan(sub {
+	my($version,$key,$val,$path,$domain,$port,
+	   $path_spec,$secure,$expires,$discard,$rest) = @_;
+	return if $discard && $skip_discard;
+	my @h = ($key, $val);
+	push(@h, "path", $path);
+	push(@h, "domain" => $domain);
+	push(@h, "port" => $port) if defined $port;
+	push(@h, "path_spec" => undef) if $path_spec;
+	push(@h, "secure" => undef) if $secure;
+	push(@h, "expires" => HTTP::Date::time2isoz($expires)) if $expires;
+	push(@h, "discard" => undef) if $discard;
+	my $k;
+	for $k (sort keys %$rest) {
+	    push(@h, $k, $rest->{$k});
+	}
+	push(@h, "version" => $version);
+	push(@res, "Set-Cookie3: " . join_header_words(\@h));
+    });
+    join("\n", @res, "");
+}
+
+sub _host
+{
+    my($request, $url) = @_;
+    if (my $h = $request->header("Host")) {
+	$h =~ s/:\d+$//;  # might have a port as well
+	return lc($h);
+    }
+    return lc($url->host);
+}
+
+sub _url_path
+{
+    my $url = shift;
+    my $path;
+    if($url->can('epath')) {
+       $path = $url->epath;    # URI::URL method
+    }
+    else {
+       $path = $url->path;           # URI::_generic method
+    }
+    $path = "/" unless length $path;
+    $path;
+}
+
+sub _normalize_path  # so that plain string compare can be used
+{
+    my $x;
+    $_[0] =~ s/%([0-9a-fA-F][0-9a-fA-F])/
+	         $x = uc($1);
+                 $x eq "2F" || $x eq "25" ? "%$x" :
+                                            pack("C", hex($x));
+              /eg;
+    $_[0] =~ s/([\0-\x20\x7f-\xff])/sprintf("%%%02X",ord($1))/eg;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTTP::Cookies - HTTP cookie jars
+
+=head1 SYNOPSIS
+
+  use HTTP::Cookies;
+  $cookie_jar = HTTP::Cookies->new(
+    file => "$ENV{'HOME'}/lwp_cookies.dat",
+    autosave => 1,
+  );
+
+  use LWP;
+  my $browser = LWP::UserAgent->new;
+  $browser->cookie_jar($cookie_jar);
+
+Or for an empty and temporary cookie jar:
+
+  use LWP;
+  my $browser = LWP::UserAgent->new;
+  $browser->cookie_jar( {} );
+
+=head1 DESCRIPTION
+
+This class is for objects that represent a "cookie jar" -- that is, a
+database of all the HTTP cookies that a given LWP::UserAgent object
+knows about.
+
+Cookies are a general mechanism which server side connections can use
+to both store and retrieve information on the client side of the
+connection.  For more information about cookies refer to
+<URL:http://curl.haxx.se/rfc/cookie_spec.html> and
+<URL:http://www.cookiecentral.com/>.  This module also implements the
+new style cookies described in I<RFC 2965>.
+The two variants of cookies are supposed to be able to coexist happily.
+
+Instances of the class I<HTTP::Cookies> are able to store a collection
+of Set-Cookie2: and Set-Cookie: headers and are able to use this
+information to initialize Cookie-headers in I<HTTP::Request> objects.
+The state of a I<HTTP::Cookies> object can be saved in and restored from
+files.
+
+=head1 METHODS
+
+The following methods are provided:
+
+=over 4
+
+=item $cookie_jar = HTTP::Cookies->new
+
+The constructor takes hash style parameters.  The following
+parameters are recognized:
+
+  file:            name of the file to restore cookies from and save cookies to
+  autosave:        save during destruction (bool)
+  ignore_discard:  save even cookies that are requested to be discarded (bool)
+  hide_cookie2:    do not add Cookie2 header to requests
+
+Future parameters might include (not yet implemented):
+
+  max_cookies               300
+  max_cookies_per_domain    20
+  max_cookie_size           4096
+
+  no_cookies   list of domain names that we never return cookies to
+
+=item $cookie_jar->add_cookie_header( $request )
+
+The add_cookie_header() method will set the appropriate Cookie:-header
+for the I<HTTP::Request> object given as argument.  The $request must
+have a valid url attribute before this method is called.
+
+=item $cookie_jar->extract_cookies( $response )
+
+The extract_cookies() method will look for Set-Cookie: and
+Set-Cookie2: headers in the I<HTTP::Response> object passed as
+argument.  Any of these headers that are found are used to update
+the state of the $cookie_jar.
+
+=item $cookie_jar->set_cookie( $version, $key, $val, $path, $domain, $port, $path_spec, $secure, $maxage, $discard, \%rest )
+
+The set_cookie() method updates the state of the $cookie_jar.  The
+$key, $val, $domain, $port and $path arguments are strings.  The
+$path_spec, $secure, $discard arguments are boolean values. The $maxage
+value is a number indicating number of seconds that this cookie will
+live.  A value <= 0 will delete this cookie.  %rest defines
+various other attributes like "Comment" and "CommentURL".
+
+=item $cookie_jar->save
+
+=item $cookie_jar->save( $file )
+
+This method file saves the state of the $cookie_jar to a file.
+The state can then be restored later using the load() method.  If a
+filename is not specified we will use the name specified during
+construction.  If the attribute I<ignore_discard> is set, then we
+will even save cookies that are marked to be discarded.
+
+The default is to save a sequence of "Set-Cookie3" lines.
+"Set-Cookie3" is a proprietary LWP format, not known to be compatible
+with any browser.  The I<HTTP::Cookies::Netscape> sub-class can
+be used to save in a format compatible with Netscape.
+
+=item $cookie_jar->load
+
+=item $cookie_jar->load( $file )
+
+This method reads the cookies from the file and adds them to the
+$cookie_jar.  The file must be in the format written by the save()
+method.
+
+=item $cookie_jar->revert
+
+This method empties the $cookie_jar and re-loads the $cookie_jar
+from the last save file.
+
+=item $cookie_jar->clear
+
+=item $cookie_jar->clear( $domain )
+
+=item $cookie_jar->clear( $domain, $path )
+
+=item $cookie_jar->clear( $domain, $path, $key )
+
+Invoking this method without arguments will empty the whole
+$cookie_jar.  If given a single argument only cookies belonging to
+that domain will be removed.  If given two arguments, cookies
+belonging to the specified path within that domain are removed.  If
+given three arguments, then the cookie with the specified key, path
+and domain is removed.
+
+=item $cookie_jar->clear_temporary_cookies
+
+Discard all temporary cookies. Scans for all cookies in the jar
+with either no expire field or a true C<discard> flag. To be
+called when the user agent shuts down according to RFC 2965.
+
+=item $cookie_jar->scan( \&callback )
+
+The argument is a subroutine that will be invoked for each cookie
+stored in the $cookie_jar.  The subroutine will be invoked with
+the following arguments:
+
+  0  version
+  1  key
+  2  val
+  3  path
+  4  domain
+  5  port
+  6  path_spec
+  7  secure
+  8  expires
+  9  discard
+ 10  hash
+
+=item $cookie_jar->as_string
+
+=item $cookie_jar->as_string( $skip_discardables )
+
+The as_string() method will return the state of the $cookie_jar
+represented as a sequence of "Set-Cookie3" header lines separated by
+"\n".  If $skip_discardables is TRUE, it will not return lines for
+cookies with the I<Discard> attribute.
+
+=back
+
+=head1 SEE ALSO
+
+L<HTTP::Cookies::Netscape>, L<HTTP::Cookies::Microsoft>
+
+=head1 COPYRIGHT
+
+Copyright 1997-2002 Gisle Aas
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
diff --git a/lib/HTTP/Cookies/Microsoft.pm b/lib/HTTP/Cookies/Microsoft.pm
new file mode 100644
index 0000000..9c69fa3
--- /dev/null
+++ b/lib/HTTP/Cookies/Microsoft.pm
@@ -0,0 +1,329 @@
+package HTTP::Cookies::Microsoft;
+
+use strict;
+
+use vars qw(@ISA $VERSION);
+
+$VERSION = "6.00";
+
+require HTTP::Cookies;
+@ISA=qw(HTTP::Cookies);
+
+sub load_cookies_from_file
+{
+	my ($file) = @_;
+	my @cookies;
+	my ($key, $value, $domain_path, $flags, $lo_expire, $hi_expire);
+	my ($lo_create, $hi_create, $sep);
+
+	open(COOKIES, $file) || return;
+
+	while ($key = <COOKIES>)
+	{
+		chomp($key);
+		chomp($value     = <COOKIES>);
+		chomp($domain_path= <COOKIES>);
+		chomp($flags     = <COOKIES>);		# 0x0001 bit is for secure
+		chomp($lo_expire = <COOKIES>);
+		chomp($hi_expire = <COOKIES>);
+		chomp($lo_create = <COOKIES>);
+		chomp($hi_create = <COOKIES>);
+		chomp($sep       = <COOKIES>);
+
+		if (!defined($key) || !defined($value) || !defined($domain_path) ||
+			!defined($flags) || !defined($hi_expire) || !defined($lo_expire) ||
+			!defined($hi_create) || !defined($lo_create) || !defined($sep) ||
+			($sep ne '*'))
+		{
+			last;
+		}
+
+		if ($domain_path =~ /^([^\/]+)(\/.*)$/)
+		{
+			my $domain = $1;
+			my $path = $2;
+
+			push(@cookies, {KEY => $key, VALUE => $value, DOMAIN => $domain,
+					PATH => $path, FLAGS =>$flags, HIXP =>$hi_expire,
+					LOXP => $lo_expire, HICREATE => $hi_create,
+					LOCREATE => $lo_create});
+		}
+	}
+
+	return \@cookies;
+}
+
+sub get_user_name
+{
+	use Win32;
+	use locale;
+	my $user = lc(Win32::LoginName());
+
+	return $user;
+}
+
+# MSIE stores create and expire times as Win32 FILETIME,
+# which is 64 bits of 100 nanosecond intervals since Jan 01 1601
+#
+# But Cookies code expects time in 32-bit value expressed
+# in seconds since Jan 01 1970
+#
+sub epoch_time_offset_from_win32_filetime
+{
+	my ($high, $low) = @_;
+
+	#--------------------------------------------------------
+	# USEFUL CONSTANT
+	#--------------------------------------------------------
+	# 0x019db1de 0xd53e8000 is 1970 Jan 01 00:00:00 in Win32 FILETIME
+	#
+	# 100 nanosecond intervals == 0.1 microsecond intervals
+	
+	my $filetime_low32_1970 = 0xd53e8000;
+	my $filetime_high32_1970 = 0x019db1de;
+
+	#------------------------------------
+	# ALGORITHM
+	#------------------------------------
+	# To go from 100 nanosecond intervals to seconds since 00:00 Jan 01 1970:
+	#
+	# 1. Adjust 100 nanosecond intervals to Jan 01 1970 base
+	# 2. Divide by 10 to get to microseconds (1/millionth second)
+	# 3. Divide by 1000000 (10 ^ 6) to get to seconds
+	#
+	# We can combine Step 2 & 3 into one divide.
+	#
+	# After much trial and error, I came up with the following code which
+	# avoids using Math::BigInt or floating pt, but still gives correct answers
+
+	# If the filetime is before the epoch, return 0
+	if (($high < $filetime_high32_1970) ||
+	    (($high == $filetime_high32_1970) && ($low < $filetime_low32_1970)))
+    	{
+		return 0;
+	}
+
+	# Can't multiply by 0x100000000, (1 << 32),
+	# without Perl issuing an integer overflow warning
+	#
+	# So use two multiplies by 0x10000 instead of one multiply by 0x100000000
+	#
+	# The result is the same.
+	#
+	my $date1970 = (($filetime_high32_1970 * 0x10000) * 0x10000) + $filetime_low32_1970;
+	my $time = (($high * 0x10000) * 0x10000) + $low;
+
+	$time -= $date1970;
+	$time /= 10000000;
+
+	return $time;
+}
+
+sub load_cookie
+{
+	my($self, $file) = @_;
+        my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+	my $cookie_data;
+
+        if (-f $file)
+        {
+		# open the cookie file and get the data
+		$cookie_data = load_cookies_from_file($file);
+
+		foreach my $cookie (@{$cookie_data})
+		{
+			my $secure = ($cookie->{FLAGS} & 1) != 0;
+			my $expires = epoch_time_offset_from_win32_filetime($cookie->{HIXP}, $cookie->{LOXP});
+
+			$self->set_cookie(undef, $cookie->{KEY}, $cookie->{VALUE}, 
+					  $cookie->{PATH}, $cookie->{DOMAIN}, undef,
+					  0, $secure, $expires-$now, 0);
+		}
+	}
+}
+
+sub load
+{
+	my($self, $cookie_index) = @_;
+	my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+	my $cookie_dir = '';
+	my $delay_load = (defined($self->{'delayload'}) && $self->{'delayload'});
+	my $user_name = get_user_name();
+	my $data;
+
+	$cookie_index ||= $self->{'file'} || return;
+	if ($cookie_index =~ /[\\\/][^\\\/]+$/)
+	{
+		$cookie_dir = $` . "\\";
+	}
+
+	local(*INDEX, $_);
+
+	open(INDEX, $cookie_index) || return;
+	binmode(INDEX);
+	if (256 != read(INDEX, $data, 256))
+	{
+		warn "$cookie_index file is not large enough";
+		close(INDEX);
+		return;
+	}
+
+	# Cookies' index.dat file starts with 32 bytes of signature
+	# followed by an offset to the first record, stored as a little-endian DWORD
+	my ($sig, $size) = unpack('a32 V', $data);
+	
+	if (($sig !~ /^Client UrlCache MMF Ver 5\.2/) || # check that sig is valid (only tested in IE6.0)
+		(0x4000 != $size))
+	{
+		warn "$cookie_index ['$sig' $size] does not seem to contain cookies";
+		close(INDEX);
+		return;
+	}
+
+	if (0 == seek(INDEX, $size, 0)) # move the file ptr to start of the first record
+	{
+		close(INDEX);
+		return;
+	}
+
+	# Cookies are usually stored in 'URL ' records in two contiguous 0x80 byte sectors (256 bytes)
+	# so read in two 0x80 byte sectors and adjust if not a Cookie.
+	while (256 == read(INDEX, $data, 256))
+	{
+		# each record starts with a 4-byte signature
+		# and a count (little-endian DWORD) of 0x80 byte sectors for the record
+		($sig, $size) = unpack('a4 V', $data);
+
+		# Cookies are found in 'URL ' records
+		if ('URL ' ne $sig)
+		{
+			# skip over uninteresting record: I've seen 'HASH' and 'LEAK' records
+			if (($sig eq 'HASH') || ($sig eq 'LEAK'))
+			{
+				# '-2' takes into account the two 0x80 byte sectors we've just read in
+				if (($size > 0) && ($size != 2))
+				{
+				    if (0 == seek(INDEX, ($size-2)*0x80, 1))
+				    {
+					    # Seek failed. Something's wrong. Gonna stop.
+					    last;
+				    }
+				}
+			}
+			next;
+		}
+
+		#$REMOVE Need to check if URL records in Cookies' index.dat will
+		#        ever use more than two 0x80 byte sectors
+		if ($size > 2)
+		{
+			my $more_data = ($size-2)*0x80;
+
+			if ($more_data != read(INDEX, $data, $more_data, 256))
+			{
+				last;
+			}
+		}
+
+                (my $user_name2 = $user_name) =~ s/ /_/g;
+		if ($data =~ /Cookie\:\Q$user_name\E\@([\x21-\xFF]+).*?((?:\Q$user_name\E|\Q$user_name2\E)\@[\x21-\xFF]+\.txt)/)
+		{
+			my $cookie_file = $cookie_dir . $2; # form full pathname
+
+			if (!$delay_load)
+			{
+				$self->load_cookie($cookie_file);
+			}
+			else
+			{
+				my $domain = $1;
+
+				# grab only the domain name, drop everything from the first dir sep on
+				if ($domain =~ m{[\\/]})
+				{
+					$domain = $`;
+				}
+
+				# set the delayload cookie for this domain with 
+				# the cookie_file as cookie for later-loading info
+				$self->set_cookie(undef, 'cookie', $cookie_file,
+						      '//+delayload', $domain, undef,
+						      0, 0, $now+86400, 0);
+			}
+		}
+	}
+
+	close(INDEX);
+
+	1;
+}
+
+1;
+
+__END__
+
+=head1 NAME
+
+HTTP::Cookies::Microsoft - access to Microsoft cookies files
+
+=head1 SYNOPSIS
+
+ use LWP;
+ use HTTP::Cookies::Microsoft;
+ use Win32::TieRegistry(Delimiter => "/");
+ my $cookies_dir = $Registry->
+      {"CUser/Software/Microsoft/Windows/CurrentVersion/Explorer/Shell Folders/Cookies"};
+
+ $cookie_jar = HTTP::Cookies::Microsoft->new(
+                   file     => "$cookies_dir\\index.dat",
+                   'delayload' => 1,
+               );
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar( $cookie_jar );
+
+=head1 DESCRIPTION
+
+This is a subclass of C<HTTP::Cookies> which
+loads Microsoft Internet Explorer 5.x and 6.x for Windows (MSIE)
+cookie files.
+
+See the documentation for L<HTTP::Cookies>.
+
+=head1 METHODS
+
+The following methods are provided:
+
+=over 4
+
+=item $cookie_jar = HTTP::Cookies::Microsoft->new;
+
+The constructor takes hash style parameters. In addition
+to the regular HTTP::Cookies parameters, HTTP::Cookies::Microsoft
+recognizes the following:
+
+  delayload:       delay loading of cookie data until a request
+                   is actually made. This results in faster
+                   runtime unless you use most of the cookies
+                   since only the domain's cookie data
+                   is loaded on demand.
+
+=back
+
+=head1 CAVEATS
+
+Please note that the code DOESN'T support saving to the MSIE
+cookie file format.
+
+=head1 AUTHOR
+
+Johnny Lee <typo_pl@hotmail.com>
+
+=head1 COPYRIGHT
+
+Copyright 2002 Johnny Lee
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
+
diff --git a/lib/HTTP/Cookies/Netscape.pm b/lib/HTTP/Cookies/Netscape.pm
new file mode 100644
index 0000000..5972029
--- /dev/null
+++ b/lib/HTTP/Cookies/Netscape.pm
@@ -0,0 +1,114 @@
+package HTTP::Cookies::Netscape;
+
+use strict;
+use vars qw(@ISA $VERSION);
+
+$VERSION = "6.00";
+
+require HTTP::Cookies;
+@ISA=qw(HTTP::Cookies);
+
+sub load
+{
+    my($self, $file) = @_;
+    $file ||= $self->{'file'} || return;
+    local(*FILE, $_);
+    local $/ = "\n";  # make sure we got standard record separator
+    my @cookies;
+    open(FILE, $file) || return;
+    my $magic = <FILE>;
+    unless ($magic =~ /^\#(?: Netscape)? HTTP Cookie File/) {
+	warn "$file does not look like a netscape cookies file" if $^W;
+	close(FILE);
+	return;
+    }
+    my $now = time() - $HTTP::Cookies::EPOCH_OFFSET;
+    while (<FILE>) {
+	next if /^\s*\#/;
+	next if /^\s*$/;
+	tr/\n\r//d;
+	my($domain,$bool1,$path,$secure, $expires,$key,$val) = split(/\t/, $_);
+	$secure = ($secure eq "TRUE");
+	$self->set_cookie(undef,$key,$val,$path,$domain,undef,
+			  0,$secure,$expires-$now, 0);
+    }
+    close(FILE);
+    1;
+}
+
+sub save
+{
+    my($self, $file) = @_;
+    $file ||= $self->{'file'} || return;
+    local(*FILE, $_);
+    open(FILE, ">$file") || return;
+
+    # Use old, now broken link to the old cookie spec just in case something
+    # else (not us!) requires the comment block exactly this way.
+    print FILE <<EOT;
+# Netscape HTTP Cookie File
+# http://www.netscape.com/newsref/std/cookie_spec.html
+# This is a generated file!  Do not edit.
+
+EOT
+
+    my $now = time - $HTTP::Cookies::EPOCH_OFFSET;
+    $self->scan(sub {
+	my($version,$key,$val,$path,$domain,$port,
+	   $path_spec,$secure,$expires,$discard,$rest) = @_;
+	return if $discard && !$self->{ignore_discard};
+	$expires = $expires ? $expires - $HTTP::Cookies::EPOCH_OFFSET : 0;
+	return if $now > $expires;
+	$secure = $secure ? "TRUE" : "FALSE";
+	my $bool = $domain =~ /^\./ ? "TRUE" : "FALSE";
+	print FILE join("\t", $domain, $bool, $path, $secure, $expires, $key, $val), "\n";
+    });
+    close(FILE);
+    1;
+}
+
+1;
+__END__
+
+=head1 NAME
+
+HTTP::Cookies::Netscape - access to Netscape cookies files
+
+=head1 SYNOPSIS
+
+ use LWP;
+ use HTTP::Cookies::Netscape;
+ $cookie_jar = HTTP::Cookies::Netscape->new(
+   file => "c:/program files/netscape/users/ZombieCharity/cookies.txt",
+ );
+ my $browser = LWP::UserAgent->new;
+ $browser->cookie_jar( $cookie_jar );
+
+=head1 DESCRIPTION
+
+This is a subclass of C<HTTP::Cookies> that reads (and optionally
+writes) Netscape/Mozilla cookie files.
+
+See the documentation for L<HTTP::Cookies>.
+
+=head1 CAVEATS
+
+Please note that the Netscape/Mozilla cookie file format can't store
+all the information available in the Set-Cookie2 headers, so you will
+probably lose some information if you save in this format.
+
+At time of writing, this module seems to work fine with Mozilla      
+Phoenix/Firebird.
+
+=head1 SEE ALSO
+
+L<HTTP::Cookies::Microsoft>
+
+=head1 COPYRIGHT
+
+Copyright 2002-2003 Gisle Aas
+
+This library is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
+
+=cut
diff --git a/t/cookies.t b/t/cookies.t
new file mode 100644
index 0000000..38fc67e
--- /dev/null
+++ b/t/cookies.t
@@ -0,0 +1,706 @@
+#!perl -w
+
+use Test;
+plan tests => 66;
+
+use HTTP::Cookies;
+use HTTP::Request;
+use HTTP::Response;
+
+#-------------------------------------------------------------------
+# First we check that it works for the original example at
+# http://curl.haxx.se/rfc/cookie_spec.html
+
+# Client requests a document, and receives in the response:
+# 
+#       Set-Cookie: CUSTOMER=WILE_E_COYOTE; path=/; expires=Wednesday, 09-Nov-99 23:12:40 GMT
+# 
+# When client requests a URL in path "/" on this server, it sends:
+# 
+#       Cookie: CUSTOMER=WILE_E_COYOTE
+# 
+# Client requests a document, and receives in the response:
+# 
+#       Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/
+# 
+# When client requests a URL in path "/" on this server, it sends:
+# 
+#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001
+# 
+# Client receives:
+# 
+#       Set-Cookie: SHIPPING=FEDEX; path=/fo
+# 
+# When client requests a URL in path "/" on this server, it sends:
+# 
+#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001
+# 
+# When client requests a URL in path "/foo" on this server, it sends:
+# 
+#       Cookie: CUSTOMER=WILE_E_COYOTE; PART_NUMBER=ROCKET_LAUNCHER_0001; SHIPPING=FEDEX
+# 
+# The last Cookie is buggy, because both specifications says that the
+# most specific cookie must be sent first.  SHIPPING=FEDEX is the
+# most specific and should thus be first.
+
+my $year_plus_one = (localtime)[5] + 1900 + 1;
+
+$c = HTTP::Cookies->new;
+
+$req = HTTP::Request->new(GET => "http://1.1.1.1/");
+$req->header("Host", "www.acme.com:80");
+
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->header("Set-Cookie" => "CUSTOMER=WILE_E_COYOTE; path=/ ; expires=Wednesday, 09-Nov-$year_plus_one 23:12:40 GMT");
+#print $res->as_string;
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/");
+$c->add_cookie_header($req);
+
+ok($req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE");
+ok($req->header("Cookie2"), "\$Version=\"1\"");
+
+$res->request($req);
+$res->header("Set-Cookie" => "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/");
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/foo/bar");
+$c->add_cookie_header($req);
+
+$h = $req->header("Cookie");
+ok($h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/);
+ok($h =~ /CUSTOMER=WILE_E_COYOTE/);
+
+$res->request($req);
+$res->header("Set-Cookie", "SHIPPING=FEDEX; path=/foo");
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/");
+$c->add_cookie_header($req);
+
+$h = $req->header("Cookie");
+ok($h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/);
+ok($h =~ /CUSTOMER=WILE_E_COYOTE/);
+ok($h !~ /SHIPPING=FEDEX/);
+
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/foo/");
+$c->add_cookie_header($req);
+
+$h = $req->header("Cookie");
+ok($h =~ /PART_NUMBER=ROCKET_LAUNCHER_0001/);
+ok($h =~ /CUSTOMER=WILE_E_COYOTE/);
+ok($h =~ /^SHIPPING=FEDEX;/);
+
+print $c->as_string;
+
+
+# Second Example transaction sequence:
+# 
+# Assume all mappings from above have been cleared.
+# 
+# Client receives:
+# 
+#       Set-Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001; path=/
+# 
+# When client requests a URL in path "/" on this server, it sends:
+# 
+#       Cookie: PART_NUMBER=ROCKET_LAUNCHER_0001
+# 
+# Client receives:
+# 
+#       Set-Cookie: PART_NUMBER=RIDING_ROCKET_0023; path=/ammo
+# 
+# When client requests a URL in path "/ammo" on this server, it sends:
+# 
+#       Cookie: PART_NUMBER=RIDING_ROCKET_0023; PART_NUMBER=ROCKET_LAUNCHER_0001
+# 
+#       NOTE: There are two name/value pairs named "PART_NUMBER" due to
+#       the inheritance of the "/" mapping in addition to the "/ammo" mapping. 
+
+$c = HTTP::Cookies->new;  # clear it
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/");
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->header("Set-Cookie", "PART_NUMBER=ROCKET_LAUNCHER_0001; path=/");
+
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/");
+$c->add_cookie_header($req);
+
+ok($req->header("Cookie"), "PART_NUMBER=ROCKET_LAUNCHER_0001");
+
+$res->request($req);
+$res->header("Set-Cookie", "PART_NUMBER=RIDING_ROCKET_0023; path=/ammo");
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/ammo");
+$c->add_cookie_header($req);
+
+ok($req->header("Cookie") =~
+       /^PART_NUMBER=RIDING_ROCKET_0023;\s*PART_NUMBER=ROCKET_LAUNCHER_0001/);
+
+print $c->as_string;
+undef($c);
+
+
+#-------------------------------------------------------------------
+# When there are no "Set-Cookie" header, then even responses
+# without any request URLs connected should be allowed.
+
+$c = HTTP::Cookies->new;
+$c->extract_cookies(HTTP::Response->new("200", "OK"));
+ok(count_cookies($c), 0);
+
+
+#-------------------------------------------------------------------
+# Then we test with the examples from RFC 2965.
+#
+# 5.  EXAMPLES
+
+$c = HTTP::Cookies->new;
+
+# 
+# 5.1  Example 1
+# 
+# Most detail of request and response headers has been omitted.  Assume
+# the user agent has no stored cookies.
+# 
+#   1.  User Agent -> Server
+# 
+#       POST /acme/login HTTP/1.1
+#       [form data]
+# 
+#       User identifies self via a form.
+# 
+#   2.  Server -> User Agent
+# 
+#       HTTP/1.1 200 OK
+#       Set-Cookie2: Customer="WILE_E_COYOTE"; Version="1"; Path="/acme"
+# 
+#       Cookie reflects user's identity.
+
+$cookie = interact($c, 'http://www.acme.com/acme/login',
+                       'Customer="WILE_E_COYOTE"; Version="1"; Path="/acme"');
+ok(!$cookie);
+
+# 
+#   3.  User Agent -> Server
+# 
+#       POST /acme/pickitem HTTP/1.1
+#       Cookie: $Version="1"; Customer="WILE_E_COYOTE"; $Path="/acme"
+#       [form data]
+# 
+#       User selects an item for ``shopping basket.''
+# 
+#   4.  Server -> User Agent
+# 
+#       HTTP/1.1 200 OK
+#       Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1";
+#               Path="/acme"
+# 
+#       Shopping basket contains an item.
+
+$cookie = interact($c, 'http://www.acme.com/acme/pickitem',
+		       'Part_Number="Rocket_Launcher_0001"; Version="1"; Path="/acme"');
+ok($cookie =~ m(^\$Version="?1"?; Customer="?WILE_E_COYOTE"?; \$Path="/acme"$));
+
+# 
+#   5.  User Agent -> Server
+# 
+#       POST /acme/shipping HTTP/1.1
+#       Cookie: $Version="1";
+#               Customer="WILE_E_COYOTE"; $Path="/acme";
+#               Part_Number="Rocket_Launcher_0001"; $Path="/acme"
+#       [form data]
+# 
+#       User selects shipping method from form.
+# 
+#   6.  Server -> User Agent
+# 
+#       HTTP/1.1 200 OK
+#       Set-Cookie2: Shipping="FedEx"; Version="1"; Path="/acme"
+# 
+#       New cookie reflects shipping method.
+
+$cookie = interact($c, "http://www.acme.com/acme/shipping",
+		   'Shipping="FedEx"; Version="1"; Path="/acme"');
+
+ok($cookie =~ /^\$Version="?1"?;/);
+ok($cookie =~ /Part_Number="?Rocket_Launcher_0001"?;\s*\$Path="\/acme"/);
+ok($cookie =~ /Customer="?WILE_E_COYOTE"?;\s*\$Path="\/acme"/);
+
+# 
+#   7.  User Agent -> Server
+# 
+#       POST /acme/process HTTP/1.1
+#       Cookie: $Version="1";
+#               Customer="WILE_E_COYOTE"; $Path="/acme";
+#               Part_Number="Rocket_Launcher_0001"; $Path="/acme";
+#               Shipping="FedEx"; $Path="/acme"
+#       [form data]
+# 
+#       User chooses to process order.
+# 
+#   8.  Server -> User Agent
+# 
+#       HTTP/1.1 200 OK
+# 
+#       Transaction is complete.
+
+$cookie = interact($c, "http://www.acme.com/acme/process");
+print "FINAL COOKIE: $cookie\n";
+ok($cookie =~ /Shipping="?FedEx"?;\s*\$Path="\/acme"/);
+ok($cookie =~ /WILE_E_COYOTE/);
+
+# 
+# The user agent makes a series of requests on the origin server, after
+# each of which it receives a new cookie.  All the cookies have the same
+# Path attribute and (default) domain.  Because the request URLs all have
+# /acme as a prefix, and that matches the Path attribute, each request
+# contains all the cookies received so far.
+
+print $c->as_string;
+
+
+# 5.2  Example 2
+# 
+# This example illustrates the effect of the Path attribute.  All detail
+# of request and response headers has been omitted.  Assume the user agent
+# has no stored cookies.
+
+$c = HTTP::Cookies->new;
+
+# Imagine the user agent has received, in response to earlier requests,
+# the response headers
+# 
+# Set-Cookie2: Part_Number="Rocket_Launcher_0001"; Version="1";
+#         Path="/acme"
+# 
+# and
+# 
+# Set-Cookie2: Part_Number="Riding_Rocket_0023"; Version="1";
+#         Path="/acme/ammo"
+
+interact($c, "http://www.acme.com/acme/ammo/specific",
+             'Part_Number="Rocket_Launcher_0001"; Version="1"; Path="/acme"',
+             'Part_Number="Riding_Rocket_0023"; Version="1"; Path="/acme/ammo"');
+
+# A subsequent request by the user agent to the (same) server for URLs of
+# the form /acme/ammo/...  would include the following request header:
+# 
+# Cookie: $Version="1";
+#         Part_Number="Riding_Rocket_0023"; $Path="/acme/ammo";
+#         Part_Number="Rocket_Launcher_0001"; $Path="/acme"
+# 
+# Note that the NAME=VALUE pair for the cookie with the more specific Path
+# attribute, /acme/ammo, comes before the one with the less specific Path
+# attribute, /acme.  Further note that the same cookie name appears more
+# than once.
+
+$cookie = interact($c, "http://www.acme.com/acme/ammo/...");
+ok($cookie =~ /Riding_Rocket_0023.*Rocket_Launcher_0001/);
+
+# A subsequent request by the user agent to the (same) server for a URL of
+# the form /acme/parts/ would include the following request header:
+# 
+# Cookie: $Version="1"; Part_Number="Rocket_Launcher_0001"; $Path="/acme"
+# 
+# Here, the second cookie's Path attribute /acme/ammo is not a prefix of
+# the request URL, /acme/parts/, so the cookie does not get forwarded to
+# the server.
+
+$cookie = interact($c, "http://www.acme.com/acme/parts/");
+ok($cookie =~ /Rocket_Launcher_0001/);
+ok($cookie !~ /Riding_Rocket_0023/);
+
+print $c->as_string;
+
+#-----------------------------------------------------------------------
+
+# Test rejection of Set-Cookie2 responses based on domain, path or port
+
+$c = HTTP::Cookies->new;
+
+# illegal domain (no embedded dots)
+$cookie = interact($c, "http://www.acme.com", 'foo=bar; domain=".com"');
+ok(count_cookies($c), 0);
+
+# legal domain
+$cookie = interact($c, "http://www.acme.com", 'foo=bar; domain="acme.com"');
+ok(count_cookies($c), 1);
+
+# illegal domain (host prefix "www.a" contains a dot)
+$cookie = interact($c, "http://www.a.acme.com", 'foo=bar; domain="acme.com"');
+ok(count_cookies($c), 1);
+
+# legal domain
+$cookie = interact($c, "http://www.a.acme.com", 'foo=bar; domain=".a.acme.com"');
+ok(count_cookies($c), 2);
+
+# can't use a IP-address as domain
+$cookie = interact($c, "http://125.125.125.125", 'foo=bar; domain="125.125.125"');
+ok(count_cookies($c), 2);
+
+# illegal path (must be prefix of request path)
+$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=".sol.no"; path="/foo"');
+ok(count_cookies($c), 2);
+
+# legal path
+$cookie = interact($c, "http://www.sol.no/foo/bar", 'foo=bar; domain=".sol.no"; path="/foo"');
+ok(count_cookies($c), 3);
+
+# illegal port (request-port not in list)
+$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=".sol.no"; port="90,100"');
+ok(count_cookies($c), 3);
+
+# legal port
+$cookie = interact($c, "http://www.sol.no", 'foo=bar; domain=".sol.no"; port="90,100, 80,8080"; max-age=100; Comment = "Just kidding! (\"|\\\\) "');
+ok(count_cookies($c), 4);
+
+# port attribute without any value (current port)
+$cookie = interact($c, "http://www.sol.no", 'foo9=bar; domain=".sol.no"; port; max-age=100;');
+ok(count_cookies($c), 5);
+
+# encoded path
+$cookie = interact($c, "http://www.sol.no/foo/", 'foo8=bar; path="/%66oo"');
+ok(count_cookies($c), 6);
+
+my $file = "lwp-cookies-$$.txt";
+$c->save($file);
+$old = $c->as_string;
+undef($c);
+
+$c = HTTP::Cookies->new;
+$c->load($file);
+unlink($file) || warn "Can't unlink $file: $!";
+
+ok($old, $c->as_string);
+
+undef($c);
+
+#
+# Try some URL encodings of the PATHs
+#
+$c = HTTP::Cookies->new;
+interact($c, "http://www.acme.com/foo%2f%25/%40%40%0Anew%E5/%E5", 'foo  =   bar; version    =   1');
+print $c->as_string;
+
+$cookie = interact($c, "http://www.acme.com/foo%2f%25/@@%0anewå/æøå", "bar=baz; path=\"/foo/\"; version=1");
+ok($cookie =~ /foo=bar/);
+ok($cookie =~ /^\$version=\"?1\"?/i);
+
+$cookie = interact($c, "http://www.acme.com/foo/%25/@@%0anewå/æøå");
+ok(!$cookie);
+
+undef($c);
+
+#
+# Try to use the Netscape cookie file format for saving
+#
+$file = "cookies-$$.txt";
+$c = HTTP::Cookies::Netscape->new(file => $file);
+interact($c, "http://www.acme.com/", "foo1=bar; max-age=100");
+interact($c, "http://www.acme.com/", "foo2=bar; port=\"80\"; max-age=100; Discard; Version=1");
+interact($c, "http://www.acme.com/", "foo3=bar; secure; Version=1");
+$c->save;
+undef($c);
+
+$c = HTTP::Cookies::Netscape->new(file => $file);
+ok(count_cookies($c), 1);     # 2 of them discarded on save
+
+ok($c->as_string =~ /foo1=bar/);
+undef($c);
+unlink($file);
+
+
+#
+# Some additional Netscape cookies test
+#
+$c = HTTP::Cookies->new;
+$req = HTTP::Request->new(POST => "http://foo.bar.acme.com/foo");
+
+# Netscape allows a host part that contains dots
+$res = HTTP::Response->new(200, "OK");
+$res->header(set_cookie => 'Customer=WILE_E_COYOTE; domain=.acme.com');
+$res->request($req);
+$c->extract_cookies($res);
+
+# and that the domain is the same as the host without adding a leading
+# dot to the domain.  Should not quote even if strange chars are used
+# in the cookie value.
+$res = HTTP::Response->new(200, "OK");
+$res->header(set_cookie => 'PART_NUMBER=3,4; domain=foo.bar.acme.com');
+$res->request($req);
+$c->extract_cookies($res);
+
+print $c->as_string;
+
+require URI;
+$req = HTTP::Request->new(POST => URI->new("http://foo.bar.acme.com/foo"));
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie") =~ /PART_NUMBER=3,4/);
+ok($req->header("Cookie") =~ /Customer=WILE_E_COYOTE/);
+
+
+# Test handling of local intranet hostnames without a dot
+$c->clear;
+print "---\n";
+
+interact($c, "http://example/", "foo1=bar; PORT; Discard;");
+$_=interact($c, "http://example/", 'foo2=bar; domain=".local"');
+ok(/foo1=bar/);
+
+$_=interact($c, "http://example/", 'foo3=bar');
+$_=interact($c, "http://example/");
+print "Cookie: $_\n";
+ok(/foo2=bar/);
+ok(count_cookies($c), 3);
+print $c->as_string;
+
+# Test for empty path
+# Broken web-server ORION/1.3.38 returns to the client response like
+#
+#	Set-Cookie: JSESSIONID=ABCDERANDOM123; Path=
+#
+# e.g. with Path set to nothing.
+# In this case routine extract_cookies() must set cookie to / (root)
+print "---\n";
+print "Test for empty path...\n";
+$c = HTTP::Cookies->new;  # clear it
+
+$req = HTTP::Request->new(GET => "http://www.ants.com/");
+
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->header("Set-Cookie" => "JSESSIONID=ABCDERANDOM123; Path=");
+print $res->as_string;
+$c->extract_cookies($res);
+#print $c->as_string;
+
+$req = HTTP::Request->new(GET => "http://www.ants.com/");
+$c->add_cookie_header($req);
+#print $req->as_string;
+
+ok($req->header("Cookie"), "JSESSIONID=ABCDERANDOM123");
+ok($req->header("Cookie2"), "\$Version=\"1\"");
+
+
+# missing path in the request URI
+$req = HTTP::Request->new(GET => URI->new("http://www.ants.com:8080"));
+$c->add_cookie_header($req);
+#print $req->as_string;
+
+ok($req->header("Cookie"), "JSESSIONID=ABCDERANDOM123");
+ok($req->header("Cookie2"), "\$Version=\"1\"");
+
+# test mixing of Set-Cookie and Set-Cookie2 headers.
+# Example from http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl
+# which gives up these headers:
+#
+# HTTP/1.1 200 OK
+# Connection: close
+# Date: Fri, 20 Jul 2001 19:54:58 GMT
+# Server: Apache/1.3.19 (Unix) ApacheJServ/1.1.2
+# Content-Type: text/html
+# Content-Type: text/html; charset=iso-8859-1
+# Link: </trip/stylesheet.css>; rel="stylesheet"; type="text/css"
+# Servlet-Engine: Tomcat Web Server/3.2.1 (JSP 1.1; Servlet 2.2; Java 1.3.0; SunOS 5.8 sparc; java.vendor=Sun Microsystems Inc.)
+# Set-Cookie: trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/
+# Set-Cookie: JSESSIONID=fkumjm7nt1.JS24;Path=/trs
+# Set-Cookie2: JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"
+# Title: TRIP.com Travel - FlightTRACKER
+# X-Meta-Description: Trip.com privacy policy
+# X-Meta-Keywords: privacy policy
+
+$req = HTTP::Request->new('GET', 'http://www.trip.com/trs/trip/flighttracker/flight_tracker_home.xsl');
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->push_header("Set-Cookie"  => qq(trip.appServer=1111-0000-x-024;Domain=.trip.com;Path=/));
+$res->push_header("Set-Cookie"  => qq(JSESSIONID=fkumjm7nt1.JS24;Path=/trs));
+$res->push_header("Set-Cookie2" => qq(JSESSIONID=fkumjm7nt1.JS24;Version=1;Discard;Path="/trs"));
+#print $res->as_string;
+
+$c = HTTP::Cookies->new;  # clear it
+$c->extract_cookies($res);
+print $c->as_string;
+ok($c->as_string, <<'EOT');
+Set-Cookie3: trip.appServer=1111-0000-x-024; path="/"; domain=.trip.com; path_spec; discard; version=0
+Set-Cookie3: JSESSIONID=fkumjm7nt1.JS24; path="/trs"; domain=www.trip.com; path_spec; discard; version=1
+EOT
+
+#-------------------------------------------------------------------
+# Test if temporary cookies are deleted properly with
+# $jar->clear_temporary_cookies()
+
+$req = HTTP::Request->new('GET', 'http://www.perlmeister.com/scripts');
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+   # Set session/perm cookies and mark their values as "session" vs. "perm"
+   # to recognize them later
+$res->push_header("Set-Cookie"  => qq(s1=session;Path=/scripts));
+$res->push_header("Set-Cookie"  => qq(p1=perm; Domain=.perlmeister.com;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT));
+$res->push_header("Set-Cookie"  => qq(p2=perm;Path=/;expires=Fri, 02-Feb-$year_plus_one 23:24:20 GMT));
+$res->push_header("Set-Cookie"  => qq(s2=session;Path=/scripts;Domain=.perlmeister.com));
+$res->push_header("Set-Cookie2" => qq(s3=session;Version=1;Discard;Path="/"));
+
+$c = HTTP::Cookies->new;  # clear jar
+$c->extract_cookies($res);
+# How many session/permanent cookies do we have?
+my %counter = ("session_after" => 0);
+$c->scan( sub { $counter{"${_[2]}_before"}++ } );
+$c->clear_temporary_cookies();
+# How many now?
+$c->scan( sub { $counter{"${_[2]}_after"}++ } );
+ok($counter{"perm_after"}, $counter{"perm_before"}); # a permanent cookie got lost accidently
+ok($counter{"session_after"}, 0); # a session cookie hasn't been cleared
+ok($counter{"session_before"}, 3);  # we didn't have session cookies in the first place
+#print $c->as_string;
+
+
+# Test handling of 'secure ' attribute for classic cookies
+$c = HTTP::Cookies->new;
+$req = HTTP::Request->new(GET => "https://1.1.1.1/");
+$req->header("Host", "www.acme.com:80");
+
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->header("Set-Cookie" => "CUSTOMER=WILE_E_COYOTE ; secure ; path=/");
+#print $res->as_string;
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.acme.com/");
+$c->add_cookie_header($req);
+
+ok(!$req->header("Cookie"));
+
+$req->uri->scheme("https");
+$c->add_cookie_header($req);
+
+ok($req->header("Cookie"), "CUSTOMER=WILE_E_COYOTE");
+
+#print $req->as_string;
+#print $c->as_string;
+
+
+$req = HTTP::Request->new(GET => "ftp://ftp.activestate.com/");
+$c->add_cookie_header($req);
+ok(!$req->header("Cookie"));
+
+$req = HTTP::Request->new(GET => "file:/etc/motd");
+$c->add_cookie_header($req);
+ok(!$req->header("Cookie"));
+
+$req = HTTP::Request->new(GET => "mailto:gisle\@aas.no");
+$c->add_cookie_header($req);
+ok(!$req->header("Cookie"));
+
+
+# Test cookie called 'exipres' <https://rt.cpan.org/Ticket/Display.html?id=8108>
+$c = HTTP::Cookies->new;
+$req = HTTP::Request->new("GET" => "http://example.com");
+$res = HTTP::Response->new(200, "OK");
+$res->request($req);
+$res->header("Set-Cookie" => "Expires=10101");
+$c->extract_cookies($res);
+#print $c->as_string;
+ok($c->as_string, <<'EOT');
+Set-Cookie3: Expires=10101; path="/"; domain=example.com; discard; version=0
+EOT
+
+# Test empty cookie header [RT#29401]
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie" => ["CUSTOMER=WILE_E_COYOTE; path=/;", ""]);
+#print $res->as_string;
+$c->extract_cookies($res);
+#print $c->as_string;
+ok($c->as_string, <<'EOT');
+Set-Cookie3: CUSTOMER=WILE_E_COYOTE; path="/"; domain=example.com; path_spec; discard; version=0
+EOT
+
+# Test empty cookie part [RT#38480]
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie" => "CUSTOMER=WILE_E_COYOTE;;path=/;");
+#print $res->as_string;
+$c->extract_cookies($res);
+#print $c->as_string;
+ok($c->as_string, <<'EOT');
+Set-Cookie3: CUSTOMER=WILE_E_COYOTE; path="/"; domain=example.com; path_spec; discard; version=0
+EOT
+
+# Test Set-Cookie with version set
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie" => "foo=\"bar\";version=1");
+#print $res->as_string;
+$c->extract_cookies($res);
+#print $c->as_string;
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie"), "foo=\"bar\"");
+
+# Test cookies that expire far into the future [RT#50147]
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie", "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL; expires=Mon, 03-Oct-2211 15:18:10 GMT; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired1=1; expires=Mon, 03-Oct-2001 15:18:10 GMT; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired2=1; expires=Fri Jan  1 00:00:00 GMT 1970; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired3=1; expires=Fri Jan  1 00:00:01 GMT 1970; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired4=1; expires=Thu Dec 31 23:59:59 GMT 1969; path=/; domain=.example.com");
+$res->push_header("Set-Cookie", "expired5=1; expires=Fri Feb  2 00:00:00 GMT 1950; path=/; domain=.example.com");
+$c->extract_cookies($res);
+#print $res->as_string;
+#print "---\n";
+#print $c->as_string;
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie"), "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL");
+
+$c->clear_temporary_cookies;
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$c->add_cookie_header($req);
+#print $req->as_string;
+ok($req->header("Cookie"), "PREF=ID=cee18f7c4e977184:TM=1254583090:LM=1254583090:S=Pdb0-hy9PxrNj4LL");
+
+# Test merging of cookies
+$c = HTTP::Cookies->new;
+$res->header("Set-Cookie", "foo=1; path=/");
+$c->extract_cookies($res);
+
+$req = HTTP::Request->new(GET => "http://www.example.com/foo");
+$req->header("Cookie", "x=bcd");
+$c->add_cookie_header($req);
+ok($req->header("Cookie"), "x=bcd; foo=1");
+$c->add_cookie_header($req);
+ok($req->header("Cookie"), "x=bcd; foo=1; foo=1");
+#print $req->as_string;
+
+
+#-------------------------------------------------------------------
+
+sub interact
+{
+    my $c = shift;
+    my $url = shift;
+    my $req = HTTP::Request->new(POST => $url);
+    $c->add_cookie_header($req);
+    my $cookie = $req->header("Cookie");
+    my $res = HTTP::Response->new(200, "OK");
+    $res->request($req);
+    for (@_) { $res->push_header("Set-Cookie2" => $_) }
+    $c->extract_cookies($res);
+    return $cookie;
+}
+
+sub count_cookies
+{
+    my $c = shift;
+    my $no = 0;
+    $c->scan(sub { $no++ });
+    $no;
+}