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