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));