dougm 02/03/06 20:50:24
Modified: perl-framework/Apache-Test/lib/Apache TestRequest.pm
Log:
use lwp_as_string() to trace the request.
give some indication of what the request protocol was, since lwp
doesn't set HTTP::Request->protocol
Revision Changes Path
1.66 +19 -6
httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm
Index: TestRequest.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestRequest.pm,v
retrieving revision 1.65
retrieving revision 1.66
diff -u -r1.65 -r1.66
--- TestRequest.pm 7 Mar 2002 04:13:25 -0000 1.65
+++ TestRequest.pm 7 Mar 2002 04:50:24 -0000 1.66
@@ -313,7 +313,10 @@
my($r, $want_body) = @_;
my $content = $r->content;
- unless ($r->header('Content-Length') or $r->header('Transfer-Encoding'))
{
+ unless ($r->isa('HTTP::Request') or
+ $r->header('Content-Length') or
+ $r->header('Transfer-Encoding'))
+ {
$r->header('Content-Length' => length $content);
$r->header('X-Content-length-note' => 'added by
Apache::TestRequest');
}
@@ -369,11 +372,21 @@
if ($DebugLWP and not $shortcut) {
my($url, @rest) = @_;
- $name = (split '::', $name)[-1]; #strip HTTP::Request::Common::
- $url = resolve_url($url);
- print "#lwp request:\n", "#$name $url:\n#",
- $r->request->headers_as_string, "\n";
- print "#server response:\n", lwp_as_string($r, $DebugLWP > 1);
+
+ unless ($r->request->protocol) {
+ #lwp always sends a request, but never sets
+ #$r->request->protocol, happens deeper in the
+ #LWP::Protocol::http* modules
+ my $proto = user_agent_request_num($r) ? "1.1" : "1.0";
+ $r->request->protocol("HTTP/$proto");
+ }
+
+ my $want_body = $DebugLWP > 1;
+ print "#lwp request:\n",
+ lwp_as_string($r->request, $want_body);
+
+ print "#server response:\n",
+ lwp_as_string($r, $want_body);
}
die $error if $error;
