| Subject: | HTTP::Headers multiple lines issue + patch |
Hi,
I needed to work with several cookie headers and I experienced a side effect of one of the bug you reported in the BUGS section of HTTP::Headers.
H::Response->parse($str) use H::Headers->new(@flat_hdr_list) underneath
So if there's multiple line headers in $str, only the last one is taken into account.
Attached is a patch to new() to use push_header() instead of _header().
Thanks,
Yann Kerherve
PS: The issue is affecting catalyst. This has been discussed on #catalyst, fixed in the 5.5 release.
diff -ru libwww-perl-5.803/lib/HTTP/Headers.pm ../libwww-perl-5.803/lib/HTTP/Headers.pm
--- libwww-perl-5.803/lib/HTTP/Headers.pm 2004-11-12 16:38:38.000000000 +0100
+++ ../libwww-perl-5.803/lib/HTTP/Headers.pm 2005-11-15 13:02:20.000000000 +0100
@@ -69,10 +69,16 @@
{
my($class) = shift;
my $self = bless {}, $class;
- $self->header(@_) if @_; # set up initial headers
+ $self->_set_header(@_) if @_; # set up initial headers
$self;
}
+sub _set_header {
+ my $self = shift;
+ while (my($field, $val) = splice(@_, 0, 2)) {
+ $self->push_header($field, $val);
+ }
+}
sub header
{
diff -ru libwww-perl-5.803/t/base/headers.t ../libwww-perl-5.803/t/base/headers.t
--- libwww-perl-5.803/t/base/headers.t 2004-06-16 10:59:30.000000000 +0200
+++ ../libwww-perl-5.803/t/base/headers.t 2005-11-15 12:46:56.000000000 +0100
@@ -15,8 +15,8 @@
ok(ref($h), "HTTP::Headers");
ok($h->as_string, "");
-$h = HTTP::Headers->new(foo => "bar");
-ok($h->as_string, "Foo: bar\n");
+$h = HTTP::Headers->new(foo => "bar", foo => "baaaaz");
+ok($h->as_string, "Foo: bar\nFoo: baaaaz\n");
$h = HTTP::Headers->new(foo => ["bar", "baz"]);
ok($h->as_string, "Foo: bar\nFoo: baz\n");
diff -ru libwww-perl-5.803/t/base/response.t ../libwww-perl-5.803/t/base/response.t
--- libwww-perl-5.803/t/base/response.t 1996-09-18 14:19:44.000000000 +0200
+++ ../libwww-perl-5.803/t/base/response.t 2005-11-15 13:28:59.000000000 +0100
@@ -84,3 +84,8 @@
print "not " unless $r->fresh_until; # should return something
print "ok 7\n";
+
+my $r2 = HTTP::Response->parse($r->as_string);
+my @h = $r2->header('Cache-Control');
+print "not " unless scalar @h == 2;
+print "ok 8\n"