Front page | perl.libwww |
Postings from February 2011
[PATCH] lwp-request: Add a -E option to display all request andresponse headers.
From:
Tony Finch
Date:
February 8, 2011 23:59
Subject:
[PATCH] lwp-request: Add a -E option to display all request andresponse headers.
Message ID:
alpine.LSU.2.00.1102071438490.27602@hermes-1.csi.cam.ac.uk
---
bin/lwp-request | 53 +++++++++++++++++++++++++++++++----------------------
1 files changed, 31 insertions(+), 22 deletions(-)
Here's a little tweak to lwp-request that makes it more useful to debug
odd redirect problems.
diff --git a/bin/lwp-request b/bin/lwp-request
index a8ba81a..90b3dcd 100755
--- a/bin/lwp-request
+++ b/bin/lwp-request
@@ -187,8 +187,12 @@ require LWP;
use URI;
use URI::Heuristic qw(uf_uri);
-use Encode;
-use Encode::Locale;
+#use Encode;
+#use Encode::Locale;
+
+sub decode {
+ return $_[1];
+}
use HTTP::Status qw(status_message);
use HTTP::Date qw(time2str str2time);
@@ -267,11 +271,12 @@ my @getopt_args = (
'C=s', # credentials for basic authorization
'H=s@', # extra headers, form "Header: value string"
#
- 'u', # display method, URL and headers of request
+ 'u', # display method and URL of request
'U', # display request headers also
's', # display status code
'S', # display whole chain of status codes
'e', # display response headers (default for HEAD)
+ 'E', # display whole chain of headers
'd', # don't display content
#
'h', # print usage
@@ -322,12 +327,22 @@ elsif (!defined $allowed_methods{$method}) {
die "$progname: $method is not an allowed method\n";
}
+if ($options{'S'} || $options{'E'}) {
+ $options{'U'} = 1 if $options{'E'};
+ $options{'E'} = 1 if $options{'e'};
+ $options{'s'} = 1;
+ $options{'u'} = 1;
+}
+
if ($method eq "HEAD") {
$options{'s'} = 1;
$options{'e'} = 1 unless $options{'d'};
$options{'d'} = 1;
}
+$options{'u'} = 1 if $options{'U'};
+$options{'s'} = 1 if $options{'e'};
+
if (defined $options{'t'}) {
$options{'t'} =~ /^(\d+)([smh])?/;
die "$progname: Illegal timeout value!\n" unless defined $1;
@@ -391,6 +406,15 @@ if ($options{'c'}) { # will always be set for request that wants content
$errors = 0;
+sub show {
+ my $r = shift;
+ my $last = shift;
+ print $method, " ", $r->request->uri->as_string, "\n" if $options{'u'};
+ print $r->request->headers_as_string, "\n" if $options{'U'};
+ print $r->status_line, "\n" if $options{'s'};
+ print $r->headers_as_string, "\n" if $options{'E'} or $last;
+}
+
# Ok, now we perform the requests, one URL at a time
while ($url = shift) {
# Create the URL object, but protect us against bad URLs
@@ -416,28 +440,12 @@ while ($url = shift) {
$request->uri($url);
$response = $ua->request($request);
- if ($options{'u'} || $options{'U'}) {
- my $url = $response->request->uri->as_string;
- print "$method $url\n";
- print $response->request->headers_as_string, "\n" if $options{'U'};
- }
-
if ($options{'S'}) {
- for my $r ($response->redirects, $response) {
- my $method = $r->request->method;
- my $url = $r->request->uri->as_string;
- print "$method $url --> ", $r->status_line, "\n";
+ for my $r ($response->redirects) {
+ show($r);
}
}
- elsif ($options{'s'}) {
- print $response->status_line, "\n";
- }
-
- if ($options{'e'}) {
- # Display headers
- print $response->headers_as_string;
- print "\n"; # separate headers and content
- }
+ show($response, $options{'e'});
unless ($options{'d'}) {
if ($options{'o'} &&
@@ -524,6 +532,7 @@ Usage: $progname [-options] <url>...
-s Display response status code
-S Display response status chain
-e Display response headers
+ -E Display whole chain of headers
-d Do not display content
-o <format> Process HTML content in various ways
--
1.7.3.GIT
-
[PATCH] lwp-request: Add a -E option to display all request andresponse headers.
by Tony Finch