dougm 01/12/19 19:51:12
Modified: perl-framework/Apache-Test/lib/Apache TestConfig.pm
TestConfigPerl.pm TestRequest.pm TestServer.pm
Log:
get rid of http_raw_get usage / integrate with Apache::TestClient
Revision Changes Path
1.114 +0 -24
httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm
Index: TestConfig.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfig.pm,v
retrieving revision 1.113
retrieving revision 1.114
diff -u -r1.113 -r1.114
--- TestConfig.pm 2001/12/19 18:37:43 1.113
+++ TestConfig.pm 2001/12/20 03:51:11 1.114
@@ -1117,30 +1117,6 @@
return @reasons;
}
-
-#shortcuts
-
-my %include_headers = (
- GET => 1,
- GET_STR => 1,
- GET_BODY => 0,
- HEAD => 2,
- HEAD_STR => 2,
-);
-
-sub http_raw_get {
- my($self, $url, $h) = @_;
-
- $url = "/$url" unless $url =~ m:^/:;
-
- my $ih = exists $include_headers{$h ||= 0} ?
- $include_headers{$h} : $h;
-
- require Apache::TestRequest;
- Apache::TestRequest::http_raw_get($self,
- $url, $ih);
-}
-
sub error_log {
my($self, $rel) = @_;
my $file = catfile $self->{vars}->{t_logs}, 'error_log';
1.43 +2 -2
httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm
Index: TestConfigPerl.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestConfigPerl.pm,v
retrieving revision 1.42
retrieving revision 1.43
diff -u -r1.42 -r1.43
--- TestConfigPerl.pm 2001/12/10 05:25:07 1.42
+++ TestConfigPerl.pm 2001/12/20 03:51:11 1.43
@@ -76,8 +76,8 @@
my $fh = $self->genfile($t);
print $fh <<EOF;
-use Apache::Test ();
-print Apache::Test::config()->http_raw_get("/$pm");
+use Apache::TestRequest 'GET_BODY';
+print GET_BODY "/$pm";
EOF
close $fh or die "close $t: $!";
1.63 +24 -78
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.62
retrieving revision 1.63
diff -u -r1.62 -r1.63
--- TestRequest.pm 2001/12/14 08:55:25 1.62
+++ TestRequest.pm 2001/12/20 03:51:11 1.63
@@ -24,6 +24,10 @@
}
};
+unless ($have_lwp) {
+ require Apache::TestClient;
+}
+
sub has_lwp { $have_lwp }
unless ($have_lwp) {
@@ -170,13 +174,13 @@
sub vhost_socket {
my $module = shift;
- local $Apache::TestRequest::Module = $module;
+ local $Apache::TestRequest::Module = $module if $module;
my $hostport = hostport(Apache::Test::config());
my($host, $port) = split ':', $hostport;
my(%args) = (PeerAddr => $host, PeerPort => $port);
- if ($module =~ /ssl/) {
+ if ($module and $module =~ /ssl/) {
require Net::SSL;
local $ENV{https_proxy} ||= ""; #else uninitialized value in
Net/SSL.pm
return Net::SSL->new(%args, Timeout => UA_TIMEOUT);
@@ -221,9 +225,16 @@
}
sub prepare {
- user_agent();
+ my $url = shift;
+
+ if ($have_lwp) {
+ user_agent();
+ $url = resolve_url($url);
+ }
+ else {
+ lwp_debug() if $ENV{APACHE_TEST_DEBUG_LWP};
+ }
- my $url = resolve_url(shift);
my($pass, $keep) = Apache::TestConfig::filter_args([EMAIL PROTECTED],
\%wanted_args);
%credentials = ();
@@ -302,8 +313,8 @@
my($r, $want_body) = @_;
my $content = $r->content;
- unless ($r->header('Content-length') or $r->header('Transfer-Encoding'))
{
- $r->header('Content-length' => length $content);
+ unless ($r->header('Content-Length') or $r->header('Transfer-Encoding'))
{
+ $r->header('Content-Length' => length $content);
$r->header('X-Content-length-note' => 'added by Apache::TestReqest');
}
@@ -352,7 +363,7 @@
unless ($shortcut) {
#GET, HEAD, POST
- $r = $UA->request($r);
+ $r = $UA ? $UA->request($r) : $r;
my $proto = $r->protocol;
if (defined($proto)) {
if ($proto !~ /^HTTP\/(\d\.\d)$/) {
@@ -368,7 +379,7 @@
my($url, @rest) = @_;
$name = (split '::', $name)[-1]; #strip HTTP::Request::Common::
$url = resolve_url($url);
- print "$name $url:\n", $r->request->headers->as_string, "\n";
+ print "$name $url:\n", $r->request->headers_as_string, "\n";
print lwp_as_string($r, $DebugLWP > 1);
}
@@ -382,10 +393,13 @@
BODY => sub { shift->content });
for my $name (@EXPORT) {
- my $method = "HTTP::Request::Common::$name";
+ my $package = $have_lwp ?
+ 'HTTP::Request::Common': 'Apache::TestClient';
+
+ my $method = join '::', $package, $name;
no strict 'refs';
- next unless defined &$method; #else fallback a few below
+ next unless defined &$method;
*$name = sub {
my($url, $pass, $keep) = prepare(@_);
@@ -404,74 +418,6 @@
}
push @EXPORT, qw(UPLOAD_BODY);
-
-#this is intended to be a fallback if LWP is not installed
-#so at least some tests can be run, it is not meant to be robust
-
-for my $name (qw(GET_BODY GET_STR HEAD_STR)) {
- next if defined &$name;
- no strict 'refs';
- *$name = sub {
- return Apache::Test::config()->http_raw_get(shift, $name);
- };
-}
-
-sub http_raw_get {
- my($config, $url, $want_headers) = @_;
-
- $url ||= "/";
-
- if ($have_lwp) {
- if ($want_headers) {
- return $want_headers == 1 ? GET_STR($url) : HEAD_STR($url);
- }
- else {
- return GET_BODY($url);
- }
- }
-
- my $hostport = hostport($config);
-
- require IO::Socket;
- my $s = IO::Socket::INET->new($hostport);
-
- unless ($s) {
- warn "cannot connect to $hostport $!";
- return undef;
- }
-
- print $s "GET $url HTTP/1.0\n\n";
- my($response_line, $header_term, $headers);
- $headers = "";
-
- while (<$s>) {
- $headers .= $_;
- if(m:^(HTTP/\d+\.\d+)[ \t]+(\d+)[ \t]*([^\012]*):i) {
- $response_line = 1;
- }
- elsif(/^([a-zA-Z0-9_\-]+)\s*:\s*(.*)/) {
- }
- elsif(/^\015?\012$/) {
- $header_term = 1;
- last;
- }
- }
-
- unless ($response_line and $header_term) {
- warn "malformed response";
- }
- my @body = <$s>;
- close $s;
-
- if ($want_headers) {
- if ($want_headers > 1) {
- @body = (); #HEAD
- }
- unshift @body, $headers;
- }
-
- return wantarray ? @body : join '', @body;
-}
sub to_string {
my $obj = shift;
1.45 +2 -1
httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm
Index: TestServer.pm
===================================================================
RCS file:
/home/cvs/httpd-test/perl-framework/Apache-Test/lib/Apache/TestServer.pm,v
retrieving revision 1.44
retrieving revision 1.45
diff -u -r1.44 -r1.45
--- TestServer.pm 2001/12/05 09:20:02 1.44
+++ TestServer.pm 2001/12/20 03:51:11 1.45
@@ -9,6 +9,7 @@
use Apache::TestTrace;
use Apache::TestConfig ();
+use Apache::TestRequest ();
my $CTRL_M = $ENV{APACHE_TEST_NO_COLOR} ? "\n" : "\r";
@@ -483,7 +484,7 @@
my $server_up = sub {
local $SIG{__WARN__} = sub {}; #avoid "cannot connect ..." warnings
- $config->http_raw_get('/index.html');
+ Apache::TestRequest::GET_OK('/index.html');
};
if ($server_up->()) {
