LWP::Simple: patch to let you see last error

[Ed Avis]

When LWP::Simple::get() fails it would often be useful to print a more
informative error message than just 'get failed'.  The following patch
lets you say

    $got = get 'http://perl.org/';
    die "could not get page: $LWP::Simple::error" if not defined $get;

The error message is not perfect but it is a lot better than nothing.
$LWP::Simple::error is set by all the functions not just get().

diff -ru libwww-perl-5.79/lib/LWP/Simple.pm libwww-perl-5.79.new/lib/LWP/Simple.pm
--- libwww-perl-5.79/lib/LWP/Simple.pm  2004-04-09 16:36:52.000000000 +0100
+++ libwww-perl-5.79.new/lib/LWP/Simple.pm      2004-05-08 18:48:32.959497224 +0100
@@ -3,7 +3,7 @@
 # $Id: Simple.pm,v 1.40 2004/04/09 15:07:04 gisle Exp $
 
 use strict;
-use vars qw($ua %loop_check $FULL_LWP @EXPORT @EXPORT_OK $VERSION);
+use vars qw($ua $error %loop_check $FULL_LWP @EXPORT @EXPORT_OK $VERSION);
 
 require Exporter;
 
@@ -60,8 +60,14 @@
     my $request = HTTP::Request->new(GET => $url);
     my $response = $ua->request($request);
 
-    return $response->content if $response->is_success;
-    return undef;
+    if ($response->is_success) {
+       undef $error;
+       return $response->content;
+    }
+    else {
+       $error = $response->status_line;
+       return undef;
+    }
 }
 
 
@@ -74,6 +80,7 @@
     my $response = $ua->request($request);
 
     if ($response->is_success) {
+       undef $error;
        return $response unless wantarray;
        return (scalar $response->header('Content-Type'),
                scalar $response->header('Content-Length'),
@@ -82,7 +89,10 @@
                scalar $response->header('Server'),
               );
     }
-    return;
+    else {
+       $error = $response->status_line;
+       return;
+    }
 }
 
 
@@ -99,7 +109,9 @@
     }
     my $response = $ua->request($request, $callback);
     unless ($response->is_success) {
-       print STDERR $response->status_line, " <URL:$url>\n";
+       my $status = $response->status_line;
+       print STDERR "$status <URL:$url>\n";
+       $error = $status;
     }
     $response->code;
 }
@@ -113,6 +125,7 @@
     my $request = HTTP::Request->new(GET => $url);
     my $response = $ua->request($request, $file);
 
+    $error = $response->is_success ? undef : $response->status_line;
     $response->code;
 }
 
@@ -122,6 +135,7 @@
     my($url, $file) = @_;
     _init_ua() unless $ua;
     my $response = $ua->mirror($url, $file);
+    $error = $response->is_success ? undef : $response->status_line;
     $response->code;
 }
 
@@ -147,7 +161,14 @@
        }
        my $request = HTTP::Request->new(GET => $url);
        my $response = $ua->request($request);
-       return $response->is_success ? $response->content : undef;
+       if ($response->is_success) {
+           undef $error;
+           return $response->content;
+       }
+       else {
+           $error = $response->status_line;
+           return undef;
+       }
     }
 }
 
@@ -162,7 +183,11 @@
    my $sock = IO::Socket::INET->new(PeerAddr => $host,
                                     PeerPort => $port,
                                     Proto    => 'tcp',
-                                    Timeout  => 60) || return undef;
+                                    Timeout  => 60);
+   if (not $sock) {
+       $error = "could not make TCP socket to $host:$port";
+       return undef;
+   }
    $sock->autoflush;
    my $netloc = $host;
    $netloc .= ":$port" if $port != 80;
@@ -175,7 +200,10 @@
    my $buf = "";
    my $n;
    1 while $n = sysread($sock, $buf, 8*1024, length($buf));
-   return undef unless defined($n);
+   if (not defined $n) {
+       $error = 'could not read from socket';
+       return undef;
+   }
 
    if ($buf =~ m,^HTTP/\d+\.\d+\s+(\d+)[^\012]*\012,) {
        my $code = $1;
@@ -183,10 +211,16 @@
        if ($code =~ /^30[1237]/ && $buf =~ /\012Location:\s*(\S+)/i) {
            # redirect
            my $url = $1;
-           return undef if $loop_check{$url}++;
+          if ($loop_check{$url}++) {
+              $error = "redirection loop for $url";
+              return undef;
+          }
            return _get($url, $host, $port, $path);
        }
-       return undef unless $code =~ /^2/;
+       if ($code !~ /^2/) {
+          $error = "http status $code is not success";
+          return undef;
+       }
        $buf =~ s/.+?\015?\012\015?\012//s;  # zap header
    }
 
@@ -208,7 +242,7 @@
 
  use LWP::Simple;
  $content = get("http://www.sn.no/";);
- die "Couldn't get it!" unless defined $content;
+ die "Couldn't get it: $LWP::Simple::error" unless defined $content;
 
  if (mirror("http://www.sn.no/";, "foo") == RC_NOT_MODIFIED) {
      ...
@@ -325,6 +359,9 @@
 
 =back
 
+If the last call to an LWP::Simple function failed then
+C<$LWP::Simple::error> contains an error message.
+
 The module will also export the LWP::UserAgent object as C<$ua> if you
 ask for it explicitly.
 

-- 
Ed Avis <[EMAIL PROTECTED]>