File improve-fetchdoc.patch of Package whohas
#! /bin/sh /usr/share/dpatch/dpatch-run
## 40-improve-fetchdoc.dpatch by Jonathan Wiltshire <debian@jwiltshire.org.uk>
##
## All lines beginning with `## DP:' are a description of the patch.
## DP: Shift some of the burden in sub fetchdoc onto the LWP::UserAgent class
## DP: This also allows us to process XML files without breaking the first line
@DPATCH@
--- a/whohas
+++ b/whohas
@@ -1146,33 +1146,16 @@ sub fetchdoc {
my $ua = LWP::UserAgent->new;
$ua->env_proxy;
- my @firstline;
- my @response;
- for (my $count = 0; ; ++$count) { # termination condition inside loop
- my $req = HTTP::Request->new(GET => $url);
- my $res = $ua->request($req)->as_string;
- @response = split (/\n/, $res);
- @firstline = split (/ /, $response[0]);
- my $restest = 0;
- if (@firstline == 3) {
- $restest = $firstline[1];
- } elsif (@firstline > 3) {
- $restest = $firstline[0];
- }
- if ($restest == 200 || $response[0] =~ /200 OK/) { #NB the matching expression added specifically for NetBSD package page!
- # server response 200 is a stringent criterion, but should work
- last;
- } elsif ($count > 4) { # loop termination condition
- unless ($silent == 1) {
- warn ("Tried fetching \"$url\" five times. Giving up.\n");
- }
- return ();
- last;
+ my $response = $ua->get($url);
+ if($response->is_success) {
+ return $response->decoded_content;
+ } else {
+ unless ($silent == 1)
+ {
+ print("Couldn't fetch \"$url\". Giving up.\n");
}
+ return();
}
- my $end = @response - 1;
- my $finaldoc = join ("\n", @response[14..$end]);
- return ($finaldoc);
}
sub pretty_print {