102 lines
3.7 KiB
Diff
102 lines
3.7 KiB
Diff
From af111a4327d4dfc4750e022c1a20adc803a75fbf Mon Sep 17 00:00:00 2001
|
|
From: Gisle Aas <gisle@aas.no>
|
|
Date: Mon, 20 Oct 2008 13:14:48 +0200
|
|
Subject: [PATCH] Wrong content handlers would sometimes be skipped [RT#40187]
|
|
|
|
The handler filtering in LWP::Protocol::collect depends on stable
|
|
handler hashes, but we did not provide that for handlers associated
|
|
directly with the response object. The result was that handlers
|
|
was skipped randomly based on memory allocation patterns.
|
|
---
|
|
lib/LWP/Protocol.pm | 36 ++++++++++++++++++++++--------------
|
|
lib/LWP/UserAgent.pm | 12 +++++++-----
|
|
2 files changed, 29 insertions(+), 19 deletions(-)
|
|
|
|
Index: libwww-perl-5.816/lib/LWP/Protocol.pm
|
|
===================================================================
|
|
--- libwww-perl-5.816.orig/lib/LWP/Protocol.pm
|
|
+++ libwww-perl-5.816/lib/LWP/Protocol.pm
|
|
@@ -103,19 +103,25 @@ sub collect
|
|
elsif (!ref($arg) && length($arg)) {
|
|
open(my $fh, ">", $arg) || die "Can't write to '$arg': $!";
|
|
binmode($fh);
|
|
- push(@{$response->{handlers}{response_data}}, sub {
|
|
- print $fh $_[3] || die "Can't write to '$arg': $!";
|
|
- 1;
|
|
- });
|
|
- push(@{$response->{handlers}{response_done}}, sub {
|
|
- close($fh) || die "Can't write to '$arg': $!";
|
|
- undef($fh);
|
|
+ push(@{$response->{handlers}{response_data}}, {
|
|
+ callback => sub {
|
|
+ print $fh $_[3] || die "Can't write to '$arg': $!";
|
|
+ 1;
|
|
+ },
|
|
});
|
|
+ push(@{$response->{handlers}{response_done}}, {
|
|
+ callback => sub {
|
|
+ close($fh) || die "Can't write to '$arg': $!";
|
|
+ undef($fh);
|
|
+ },
|
|
+ });
|
|
}
|
|
elsif (ref($arg) eq 'CODE') {
|
|
- push(@{$response->{handlers}{response_data}}, sub {
|
|
- &$arg($_[3], $_[0], $self);
|
|
- 1;
|
|
+ push(@{$response->{handlers}{response_data}}, {
|
|
+ callback => sub {
|
|
+ &$arg($_[3], $_[0], $self);
|
|
+ 1;
|
|
+ },
|
|
});
|
|
}
|
|
else {
|
|
@@ -125,10 +131,12 @@ sub collect
|
|
$ua->run_handlers("response_header", $response);
|
|
|
|
if (delete $response->{default_add_content}) {
|
|
- push(@{$response->{handlers}{response_data}}, sub {
|
|
- $_[0]->add_content($_[3]);
|
|
- 1;
|
|
- });
|
|
+ push(@{$response->{handlers}{response_data}}, {
|
|
+ callback => sub {
|
|
+ $_[0]->add_content($_[3]);
|
|
+ 1;
|
|
+ },
|
|
+ });
|
|
}
|
|
|
|
|
|
Index: libwww-perl-5.816/lib/LWP/UserAgent.pm
|
|
===================================================================
|
|
--- libwww-perl-5.816.orig/lib/LWP/UserAgent.pm
|
|
+++ libwww-perl-5.816/lib/LWP/UserAgent.pm
|
|
@@ -613,10 +613,12 @@ sub parse_head {
|
|
$parser->xml_mode(1) if $response->content_is_xhtml;
|
|
$parser->utf8_mode(1) if $] >= 5.008 && $HTML::Parser::VERSION >= 3.40;
|
|
|
|
- push(@{$response->{handlers}{response_data}}, sub {
|
|
- return unless $parser;
|
|
- $parser->parse($_[3]) or undef($parser);
|
|
- });
|
|
+ push(@{$response->{handlers}{response_data}}, {
|
|
+ callback => sub {
|
|
+ return unless $parser;
|
|
+ $parser->parse($_[3]) or undef($parser);
|
|
+ },
|
|
+ });
|
|
|
|
} : undef,
|
|
m_media_type => "html",
|
|
@@ -765,7 +767,7 @@ sub handlers {
|
|
my($self, $phase, $o) = @_;
|
|
my @h;
|
|
if ($o->{handlers} && $o->{handlers}{$phase}) {
|
|
- push(@h, map +{ callback => $_ }, @{$o->{handlers}{$phase}});
|
|
+ push(@h, @{$o->{handlers}{$phase}});
|
|
}
|
|
if (my $conf = $self->{handlers}{$phase}) {
|
|
push(@h, $conf->matching($o));
|