> I agree it might be useful to add something like this. I don't like
> the name you selected though. The term "session" is used differently
> in RFC 2965.
Hmm ... let me throw in another suggestion: in order to distinguish
cookies which are cleared at browser shutdown from those which remain in
the jar beyond that point, they're commonly called "session cookies" vs.
"permanent cookies". Also, the following excerpt from RFC 2965 seems to
encourage that term:
"...Otherwise a cookie persists (resources permitting) until whichever
happens first, then gets discarded: its Max-Age lifetime is exceeded;
or, if the Discard attribute is set, the user agent terminates the
session."
discard() is short and sweet but could be interpreted in a way that
permanent cookies would be discarded as well, which is not the case.
Would you be ok with "discard_session_cookies()"?
I've also added code for cookies marked with the "Discard" flag as you
suggested and attached test case #36 to t/base/cookies.t. Please find
the patch file attached (hope that's ok, since it has some lengthy
lines).
-- Mike
--------------------------------------------------------
Mike Schilli [EMAIL PROTECTED] http://perlmeister.com
--------------------------------------------------------
diff -Naur libwww-perl-5.63/lib/HTTP/Cookies.pm libwww-perl-5.64/lib/HTTP/Cookies.pm
--- libwww-perl-5.63/lib/HTTP/Cookies.pm Fri Oct 26 15:45:28 2001
+++ libwww-perl-5.64/lib/HTTP/Cookies.pm Sat Feb 2 15:29:18 2002
@@ -652,6 +652,26 @@
join("\n", @res, "");
}
+=item $cookie_jar->discard_session_cookies( );
+
+Discard all session 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.
+
+=cut
+
+sub discard_session_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 _url_path
{
diff -Naur libwww-perl-5.63/t/base/cookies.t libwww-perl-5.64/t/base/cookies.t
--- libwww-perl-5.63/t/base/cookies.t Fri Jul 20 13:02:39 2001
+++ libwww-perl-5.64/t/base/cookies.t Sat Feb 2 16:12:11 2002
@@ -1,4 +1,4 @@
-print "1..35\n";
+print "1..36\n";
#use LWP::Debug '+';
use HTTP::Cookies;
@@ -565,6 +565,38 @@
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 session cookies are deleted properly with
+# $jar->discard_session_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->discard_session_cookies();
+# How many now?
+$c->scan( sub { $counter{"${_[2]}_after"}++ } );
+print "not " if # a permanent cookie got lost accidently
+ $counter{"perm_after"} != $counter{"perm_before"} or
+ # a session cookie hasn't been cleared
+ $counter{"session_after"} != 0 or
+ # we didn't have session cookies in the first place
+ $counter{"session_before"} == 0;
+#print $c->as_string;
+print "ok 36\n";
#-------------------------------------------------------------------
