home *** CD-ROM | disk | FTP | other *** search
/ PC Professionell 2004 December / PCpro_2004_12.ISO / files / webserver / xampp / xampp-perl-addon-1.4.9-installer.exe / TestCommon.pm < prev    next >
Encoding:
Perl POD Document  |  2004-03-04  |  2.8 KB  |  109 lines
  1. # Copyright 2001-2004 The Apache Software Foundation
  2. #
  3. # Licensed under the Apache License, Version 2.0 (the "License");
  4. # you may not use this file except in compliance with the License.
  5. # You may obtain a copy of the License at
  6. #
  7. #     http://www.apache.org/licenses/LICENSE-2.0
  8. #
  9. # Unless required by applicable law or agreed to in writing, software
  10. # distributed under the License is distributed on an "AS IS" BASIS,
  11. # WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  12. # See the License for the specific language governing permissions and
  13. # limitations under the License.
  14. #
  15. package Apache::TestCommon;
  16.  
  17. use strict;
  18. use warnings FATAL => 'all';
  19.  
  20. use File::Basename;
  21.  
  22. use Apache::Test;
  23. use Apache::TestRequest;
  24. use Apache::TestUtil;
  25. use Apache::TestCommonPost ();
  26.  
  27. #this module contains common tests that are called from different .t files
  28.  
  29. #t/apache/passbrigade.t
  30. #t/apache/rwrite.t
  31.  
  32. sub run_write_test {
  33.     my $module = shift;
  34.  
  35.     #1k..9k, 10k..50k, 100k, 300k, 500k, 2Mb, 4Mb, 6Mb, 10Mb
  36.     my @sizes = (1..9, 10..50, 100, 300, 500, 2000, 4000, 6000, 10_000);
  37.     my @buff_sizes = (1024, 8192);
  38.  
  39.     plan tests => @sizes * @buff_sizes, [$module, 'LWP'];
  40.  
  41.     my $location = "/$module";
  42.     my $ua = Apache::TestRequest::user_agent();
  43.  
  44.     for my $buff_size (@buff_sizes) {
  45.         for my $size (@sizes) {
  46.             my $length = $size * 1024;
  47.             my $received = 0;
  48.  
  49.             $ua->do_request(GET => "$location?$buff_size,$length",
  50.                             sub {
  51.                                 my($chunk, $res) = @_;
  52.                                 $received += length $chunk;
  53.                             });
  54.  
  55.             ok t_cmp($length, $received, 'bytes in body');
  56.         }
  57.     }
  58. }
  59.  
  60. sub run_files_test {
  61.     my($verify, $skip_other) = @_;
  62.  
  63.     my $vars = Apache::Test::vars();
  64.     my $perlpod = $vars->{perlpod};
  65.  
  66.     my %pod = (
  67.         files => [],
  68.         num   => 0,
  69.         url   => '/getfiles-perl-pod',
  70.         dir   => "",
  71.     );
  72.  
  73.     if (-d $perlpod) {
  74.         my @files = map { basename $_ } <$perlpod/*.pod>;
  75.         $pod{files} = \@files;
  76.         $pod{num} = scalar @files;
  77.         $pod{dir} = $perlpod;
  78.     }
  79.     else {
  80.         push @Apache::Test::SkipReasons,
  81.           "dir $vars->{perlpod} does not exist";
  82.     }
  83.  
  84.     my %other_files = ();
  85.  
  86.     unless ($skip_other) { #allow to skip the large binary files
  87.         %other_files = map {
  88.             ("/getfiles-binary-$_", $vars->{$_})
  89.         } qw(httpd perl);
  90.     }
  91.  
  92.     my $tests = $pod{num} + keys(%other_files);
  93.  
  94.     plan tests => $tests, sub { $pod{num} and have_lwp() };
  95.  
  96.     my $ua = Apache::TestRequest::user_agent();
  97.  
  98.     for my $file (@{ $pod{files} }) {
  99.         $verify->($ua, "$pod{url}/$file", "$pod{dir}/$file");
  100.     }
  101.  
  102.     for my $url (sort keys %other_files) {
  103.         $verify->($ua, $url, $other_files{$url});
  104.     }
  105. }
  106.  
  107. 1;
  108. __END__
  109.