| Subject: | [PATCH] split HTTP::Cookies::add_cookie_header into two methods |
I'm trying to implement cookie testing methods in Test::WWW::Mechanize
and have found myself replicating a bunch of code from
add_cookie_header() in my scan() callback. I propose that the cookie
matching code be factored out of add_cookie_header() into a separate
method. The attached patch implements such a refactoring by creating a
new method called cookie_matching() which accepts a $request and returns
an array of cookies. add_cookie_header() is thus reduced to just the
data munging steps. I've deliberately left whitespace alone to minimize
the size of the attached patch, but the code should be re-indented if
applied.
I see from
http://rt.cpan.org/Ticket/Display.html?id=12151
that you prefer not to implement a more detailed cookie inspection API,
and that you believe that web apps should employ functional tests
instead of unit tests with regard to cookies. So, I understand if you
reject this patch. However, I believe that unit tests on cookies do make
web testing code significantly simpler, and I've made my patch as
unintrusive as possible.
If this patch is acceptable, then I would be willing to document this
new method as well.
Thanks,
Chris
| Subject: | cookie.patch |
--- lib/HTTP/Cookies.pm.orig 2004-11-12 04:07:41.000000000 -0600
+++ lib/HTTP/Cookies.pm 2006-12-18 11:14:07.000000000 -0600
@@ -36,7 +36,7 @@
}
-sub add_cookie_header
+sub cookies_matching
{
my $self = shift;
my $request = shift || return;
@@ -55,8 +55,7 @@
my $now = time();
_normalize_path($req_path) if $req_path =~ /%/;
- my @cval; # cookie values for the "Cookie" header
- my $set_ver;
+ my @cookies;
my $netscape_only = 0; # An exact domain match applies to any cookie
while ($domain =~ /\./) {
@@ -120,6 +119,44 @@
LWP::Debug::debug(" it's a match");
+ push @cookies, [$key,$domain,$path,$version,$val,$port,$path_spec,$secure,$expires];
+ }
+ }
+
+ } 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;
+ }
+ }
+
+ return @cookies;
+}
+
+sub add_cookie_header
+{
+ my $self = shift;
+ my $request = shift || return;
+
+ my @cookies = $self->cookies_matching($request);
+ my @cval; # cookie values for the "Cookie" header
+ my $set_ver;
+ for my $cookie (@cookies) {
+ my ($key,$domain,$path,$version,$val,$port,$path_spec,$secure,$expires) = @$cookie;
+
# set version number of cookie header.
# XXX: What should it be if multiple matching
# Set-Cookie headers have different versions themselves
@@ -149,28 +186,6 @@
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;
- }
}
$request->header(Cookie => join("; ", @cval)) if @cval;