home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / tsw / TSW_3.4.0.exe / Apache2 / perl / TestCommon.pm < prev    next >
Encoding:
Perl POD Document  |  2002-04-01  |  2.3 KB  |  95 lines
  1. package Apache::TestCommon;
  2.  
  3. use strict;
  4. use warnings FATAL => 'all';
  5.  
  6. use File::Basename;
  7.  
  8. use Apache::Test;
  9. use Apache::TestRequest;
  10. use Apache::TestUtil;
  11. use Apache::TestCommonPost ();
  12.  
  13. #this module contains common tests that are called from different .t files
  14.  
  15. #t/apache/passbrigade.t
  16. #t/apache/rwrite.t
  17.  
  18. sub run_write_test {
  19.     my $module = shift;
  20.  
  21.     #1k..9k, 10k..50k, 100k, 300k, 500k, 2Mb, 4Mb, 6Mb, 10Mb
  22.     my @sizes = (1..9, 10..50, 100, 300, 500, 2000, 4000, 6000, 10_000);
  23.     my @buff_sizes = (1024, 8192);
  24.  
  25.     plan tests => @sizes * @buff_sizes, [$module, 'LWP'];
  26.  
  27.     my $location = "/$module";
  28.     my $ua = Apache::TestRequest::user_agent();
  29.  
  30.     for my $buff_size (@buff_sizes) {
  31.         for my $size (@sizes) {
  32.             my $length = $size * 1024;
  33.             my $received = 0;
  34.  
  35.             $ua->do_request(GET => "$location?$buff_size,$length",
  36.                             sub {
  37.                                 my($chunk, $res) = @_;
  38.                                 $received += length $chunk;
  39.                             });
  40.  
  41.             ok t_cmp($length, $received, 'bytes in body');
  42.         }
  43.     }
  44. }
  45.  
  46. sub run_files_test {
  47.     my($verify, $skip_other) = @_;
  48.  
  49.     my $vars = Apache::Test::vars();
  50.     my $perlpod = $vars->{perlpod};
  51.  
  52.     my %pod = (
  53.         files => [],
  54.         num   => 0,
  55.         url   => '/getfiles-perl-pod',
  56.         dir   => "",
  57.     );
  58.  
  59.     if (-d $perlpod) {
  60.         my @files = map { basename $_ } <$perlpod/*.pod>;
  61.         $pod{files} = \@files;
  62.         $pod{num} = scalar @files;
  63.         $pod{dir} = $perlpod;
  64.     }
  65.     else {
  66.         push @Apache::Test::SkipReasons,
  67.           "dir $vars->{perlpod} does not exist";
  68.     }
  69.  
  70.     my %other_files = ();
  71.  
  72.     unless ($skip_other) { #allow to skip the large binary files
  73.         %other_files = map {
  74.             ("/getfiles-binary-$_", $vars->{$_})
  75.         } qw(httpd perl);
  76.     }
  77.  
  78.     my $tests = $pod{num} + keys(%other_files);
  79.  
  80.     plan tests => $tests, sub { $pod{num} and have_lwp() };
  81.  
  82.     my $ua = Apache::TestRequest::user_agent();
  83.  
  84.     for my $file (@{ $pod{files} }) {
  85.         $verify->($ua, "$pod{url}/$file", "$pod{dir}/$file");
  86.     }
  87.  
  88.     for my $url (sort keys %other_files) {
  89.         $verify->($ua, $url, $other_files{$url});
  90.     }
  91. }
  92.  
  93. 1;
  94. __END__
  95.