httpd-test-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@apache.org
Subject cvs commit: httpd-test/perl-framework/Apache-Test/lib/Apache TestConfig.pm TestConfigPerl.pm TestRequest.pm TestServer.pm
Date Thu, 20 Dec 2001 03:51:12 GMT
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(\@_, \%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->()) {
  
  
  

Mime
View raw message