cvs commit: httpd-apreq/t inherit.t request-inherit.pl

[joes]

joes        2002/12/05 08:39:50

  Added:       t        inherit.t request-inherit.pl
  Log:
  Add simple Apache inheritance tests.
  
  Revision  Changes    Path
  1.1                  httpd-apreq/t/inherit.t
  
  Index: inherit.t
  ===================================================================
  use strict;
  use Apache::test;
  use Apache::src ();
  use Cwd qw(fastcwd);
  
  require HTTP::Request::Common; 
  require CGI;
  
  $HTTP::Request::Common::VERSION ||= '1.00'; #-w 
  unless ($CGI::VERSION >= 2.39 and  
        $HTTP::Request::Common::VERSION >= 1.08) {
      print "CGI.pm: $CGI::VERSION\n";
      print "HTTP::Request::Common: $HTTP::Request::Common::VERSION\n";
      skip_test;
  } 
  
  my $PWD = fastcwd;
  my @binary = "$PWD/book.gif";
  
  my $tests = 1;
  
  print "1..$tests\n";
  my $i = 0;
  my $ua = LWP::UserAgent->new;
  
  use DirHandle ();
  
  inherit_test();
  
  sub inherit_test {
      my $cv = sub { HTTP::Request::Common::GET(shift) };
      my $url = "http://localhost:$ENV{PORT}/request-inherit.pl";;
      my $response = $ua->request($cv->($url));
      my $page = $response->content;
      print $response->as_string unless $response->is_success;
      my $expect = <<EOF;
  method => GET
  hostname => localhost
  EOF
      my $ok = $page eq $expect;
      test ++$i, $ok;
      print $response->as_string unless $ok;
  }
  
  
  
  1.1                  httpd-apreq/t/request-inherit.pl
  
  Index: request-inherit.pl
  ===================================================================
  #!perl
  use strict;
  use Apache::test;
  
  my $r = Apache->request;
  $r->send_http_header('text/plain');
  
  eval {
      require Apache::Request;
  };
  
  unless (have_module "Apache::Request" and Apache::Request->can('upload')) {
      print "1..0\n";
      print $@ if $@;
      print "$INC{'Apache/Request.pm'}\n";
      return;
  }
  
  my $apr = Apache::Request->new($r);
  printf "method => %s\n", $apr->method;
  printf "hostname => %s\n", $apr->hostname;
  
  #for ($apr->param) {
  #    my(@v) = $apr->param($_);
  #    print "param $_ => ", join ",", @v;
  #    print $/;
  #}