1
0
OBS User unknown 2008-11-17 16:46:02 +00:00 committed by Git OBS Bridge
parent 7a1989e324
commit 0d930f24c6
3 changed files with 113 additions and 1 deletions

View File

@ -0,0 +1,101 @@
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));

View File

@ -1,3 +1,9 @@
-------------------------------------------------------------------
Mon Nov 17 11:25:31 CET 2008 - lnussel@suse.de
- fix https losing characters (bnc#445601,
http://rt.cpan.org/Public/Bug/Display.html?id=40187)
-------------------------------------------------------------------
Mon Oct 6 15:08:10 CEST 2008 - anicka@suse.cz

View File

@ -21,7 +21,7 @@
Name: perl-libwww-perl
BuildRequires: perl-Compress-Zlib perl-HTML-Parser perl-URI
Version: 5.816
Release: 1
Release: 2
Provides: libwww-perl
Provides: perl_lw3
Obsoletes: perl_lw3
@ -34,6 +34,7 @@ License: Artistic License
Url: http://www.cpan.org/modules/by-module/WWW/
Summary: Modules Providing a World Wide Web API
Source: libwww-perl-%{version}.tar.bz2
Patch: libwww-perl-5.816-lostchars.diff
BuildRoot: %{_tmppath}/%{name}-%{version}-build
%description
@ -50,6 +51,7 @@ Authors:
%prep
%setup -q -n libwww-perl-%{version}
%patch -p1
%build
perl Makefile.PL
@ -89,6 +91,9 @@ rm -rf $RPM_BUILD_ROOT
/var/adm/perl-modules/%{name}
%changelog
* Mon Nov 17 2008 lnussel@suse.de
- fix https losing characters (bnc#445601,
http://rt.cpan.org/Public/Bug/Display.html?id=40187)
* Mon Oct 06 2008 anicka@suse.cz
- update to 5.816
* Add missing binmode()