perl-modperl-cvs mailing list archives

Site index · List index
Message view « Date » · « Thread »
Top « Date » · « Thread »
From do...@hyperreal.org
Subject cvs commit: modperl/t/net/perl request-post.pl request-upload.pl
Date Wed, 23 Dec 1998 23:14:39 GMT
dougm       98/12/23 15:14:39

  Modified:    t/docs   startup.pl
  Added:       t/modules request.t
               t/net/perl request-post.pl request-upload.pl
  Log:
  start of tests for the new Apache::Request
  
  Revision  Changes    Path
  1.30      +4 -0      modperl/t/docs/startup.pl
  
  Index: startup.pl
  ===================================================================
  RCS file: /home/cvs/modperl/t/docs/startup.pl,v
  retrieving revision 1.29
  retrieving revision 1.30
  diff -u -r1.29 -r1.30
  --- startup.pl	1998/12/14 20:58:48	1.29
  +++ startup.pl	1998/12/23 23:14:38	1.30
  @@ -17,6 +17,10 @@
   	warn "GV alias broken\n";
   }
   
  +eval {
  +    require "local.pl"; 
  +}; $@='' if $@;
  +
   # BSD/OS 3.1 gets confused with some dynamically loaded code inside evals,
   # so make sure IO::File is loaded here, rather than later within an eval.
   # this should not harm any other platforms, since IO::File will be used
  
  
  
  1.1                  modperl/t/modules/request.t
  
  Index: request.t
  ===================================================================
  use strict;
  use Apache::test;
  
  my $Is_dougm = (defined($ENV{USER}) && ($ENV{USER} eq "dougm"));
  
  skip_test unless have_module "Apache::Request", '0.20';
  
  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 $test_pods = $ENV{UPLOAD_PODS} || ($Is_dougm ? 20 : 3);
  my $tests = 2;
  $tests += ($test_pods * 2);
  
  print "1..$tests\n";
  my $i = 0;
  my $ua = LWP::UserAgent->new;
  
  use DirHandle ();
  
  for my $cv (\&post_test, \&get_test) {
      $cv->();
  }
  
  if ($Is_dougm) {
      #try various sizes
      my $dir = "";
      for my $path (@INC) {
  	last if -d ($dir = "$path/pod");
      }
      my $dh = DirHandle->new($dir) or die $!;
      my $num = $test_pods;
      for ($dh->read) {
  	next unless /\.pod$/;
  	last unless $num-- > 0;
  	upload_test($_);
      }
  }
  else {
      for (qw(perlfunc.pod perlpod.pod perlxs.pod)) {
  	upload_test($_);
      }
  }
  
  sub post_test {
      my $enc = 'application/x-www-form-urlencoded';
      param_test(sub {
  	my($url, $data) = @_;
          HTTP::Request::Common::POST($url, 
  				    Content_Type => $enc,
  				    Content      => $data,
  				    );
      });
  }
  
  sub get_test {
      my $enc = 'application/x-www-form-urlencoded';
  
      param_test(sub {
  	my($url, $data) = @_;
          HTTP::Request::Common::GET("$url?$data");
      });
  }
  
  sub param_test {
      my $cv = shift;
      my $url = "http://$net::httpserver$net::perldir/request-param.pl";
      my $data = 
  	"ONE=ONE_value&TWO=TWO_value&" .
  	"THREE=M1&THREE=M2&THREE=M3";
  		
      my $response = $ua->request($cv->($url, $data));
  
      my $page = $response->content;
      print $response->as_string unless $response->is_success;
      my $expect = <<EOF;
  param ONE => ONE_value
  param TWO => TWO_value
  param THREE => M1,M2,M3
  EOF
      my $ok = $page eq $expect;
      test ++$i, $ok;
      print $response->as_string unless $ok;
  }
  
  sub upload_test {
      my $podfile = shift || "func";
      my $url = "http://$net::httpserver$net::perldir/request-upload.pl";
      my $file = "";
      for my $path (@INC) {
  	last if -e ($file = "$path/pod/$podfile");
      }
  
      $file = $0 unless -e $file;
      my $lines = 0;
      local *FH;
      open FH, $file or die "open $file $!";
      ++$lines while (<FH>);
      close FH;
  
      my $response = $ua->request(HTTP::Request::Common::POST($url,
  		   Content_Type => 'multipart/form-data',
  		   Content      => [count => 'count lines',
  				    filename  => [$file],
  				    ]));
  
      my $page = $response->content;
      print $response->as_string unless $response->is_success;
      test ++$i, ($page =~ m/Lines:\s+(\d+)/m);
      print "$file should have $lines lines (request-upload.pl says: $1)\n"
  	unless $1 == $lines;
      test ++$i, $1 == $lines;
  }
  
  
  
  1.1                  modperl/t/net/perl/request-post.pl
  
  Index: request-post.pl
  ===================================================================
  use strict;
  use Apache::test;
  
  my $r = shift;
  $r->send_http_header('text/plain');
  
  eval {
      require Apache::Request;
  };
  
  unless (Apache::Request->can('upload')) {
      print "1..0\n";
      print $@ if $@;
      print "$INC{'Apache/Request.pm'}\n";
      return;
  }
  
  my $apr = Apache::Request->new($r);
  
  for ($apr->param) {
      my(@v) = $apr->param($_);
      print "param $_ => ", join ",", @v;
      print $/;
  }
  
  
  
  1.1                  modperl/t/net/perl/request-upload.pl
  
  Index: request-upload.pl
  ===================================================================
  use strict;
  use Apache::test;
  
  my $r = shift;
  $r->send_http_header('text/plain');
  
  eval {
      require Apache::Request;
  };
  
  unless (Apache::Request->can('upload')) {
      print "1..0\n";
      print $@ if $@;
      print "$INC{'Apache/Request.pm'}\n";
      return;
  }
  
  my $apr = Apache::Request->new($r);
  
  for ($apr->param) {
      my(@v) = $apr->param($_);
      print "param $_ => @v\n";
  }
  
  for (my $upload = $apr->upload; $upload; $upload = $upload->next) {
      my $fh = $upload->fh;
      my $name = $upload->name;
      unless ($fh and $name) {
  	#die "Apache::Upload broken";
      }
  }
  
  my $first = $apr->upload->name;
  for my $upload ($apr->upload) {
      my $fh = $upload->fh;
      my $name = $upload->name;
      my($lines, $bytes);
      $lines = $bytes = 0;
  
      #open FH, ">/tmp/upload.txt" or die $!;
      while(<$fh>) {
  	++$lines;
  	$bytes += length;
  	print FH;
      }
      close FH;
      my $info = $upload->info;
      while (my($k,$v) = each %$info) {
  	print "INFO: $k => $v\n";
      }
      unless ($name eq $first) {
  	print "-" x 40, $/;
  	my $info = $apr->upload->info($first);
  	print "Lookup `$first':[$info]\n";
  	while (my($k,$v) = each %$info) {
  	    print "INFO: $k => $v\n";
  	}
  	my $type = $apr->uploadInfo($first, "content-type");
  	print "TYPE: $type\n";
  	print "-" x 40, $/;
      }
      my $wanted = $upload->size;
      print "Server: Lines: $lines\n";
      print "$name bytes=$bytes,wanted=$wanted\n";
  }
  
  
  
  

Mime
View raw message