commit af111a4327d4dfc4750e022c1a20adc803a75fbf
Author: Gisle Aas <gisle@aas.no>
Date: Mon Oct 20 13:14:48 2008 +0200
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.
diff --git a/lib/LWP/Protocol.pm b/lib/LWP/Protocol.pm
index b4ec93a..792e9a6 100644
--- a/lib/LWP/Protocol.pm
+++ b/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;
+ },
+ });
}
diff --git a/lib/LWP/UserAgent.pm b/lib/LWP/UserAgent.pm
index 5fb3982..1ac12eb 100644
--- a/lib/LWP/UserAgent.pm
+++ b/lib/LWP/UserAgent.pm
@@ -618,10 +618,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",
@@ -770,7 +772,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));
