—# 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
#
#
# 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::Test;
use
strict;
use
Exporter ();
use
Config;
use
Apache::TestConfig ();
BEGIN {
# Apache::Test loads a bunch of mp2 stuff while getting itself
# together. because we need to choose one of mp1 or mp2 to load
# check first (and we choose mp2) $mod_perl::VERSION == 2.0
# just because someone loaded Apache::Test. This Is Bad. so,
# let's try to correct for that here by removing mod_perl from
# %INC after the above use() statements settle in. nobody
# should be relying on us loading up mod_perl.pm anyway...
delete
$INC
{
'mod_perl.pm'
};
}
$VERSION
=
'1.43'
;
my
@need
=
qw(need_lwp need_http11 need_cgi need_access need_auth
need_module need_apache need_min_apache_version need_min_apache_fix
need_apache_version need_perl need_min_perl_version
need_min_module_version need_threads need_fork need_apache_mpm
need_php need_php4 need_ssl need_imagemap need_cache_disk)
;
my
@have
=
map
{ (
my
$need
=
$_
) =~ s/need/have/;
$need
}
@need
;
@ISA
=
qw(Exporter)
;
@EXPORT
= (
qw(sok plan skip_reason under_construction need)
,
@need
,
@have
);
%SubTests
= ();
@SkipReasons
= ();
sub
cp {
my
@l
;
for
(
my
$i
=1; (
@l
=
caller
$i
)[0] eq __PACKAGE__;
$i
++ ) {};
return
wantarray
?
@l
:
$l
[0];
}
my
$Config
;
my
%wtm
;
sub
import
{
my
$class
=
$_
[0];
my
$wtm
=0;
my
@base_exp
;
my
@exp
;
my
%my_exports
;
undef
@my_exports
{
@EXPORT
};
my
(
$caller
,
$f
,
$l
)=cp;
for
(
my
$i
=1;
$i
<
@_
;
$i
++ ) {
if
(
$_
[
$i
] eq
'-withtestmore'
) {
$wtm
=1;
}
elsif
(
$_
[
$i
] eq
':DEFAULT'
) {
push
@exp
,
$_
[
$i
];
push
@base_exp
,
$_
[
$i
];
}
elsif
(
$_
[
$i
] eq
'!:DEFAULT'
) {
push
@exp
,
$_
[
$i
];
push
@base_exp
,
$_
[
$i
];
}
elsif
(
$_
[
$i
]=~m@^[:/!]@ ) {
warn
(
"Ignoring import spec $_[$i] "
.
"at $f line $l\n"
)
}
elsif
(
exists
$my_exports
{
$_
[
$i
]} ) {
push
@exp
,
$_
[
$i
];
}
else
{
push
@base_exp
,
$_
[
$i
];
}
}
if
(!
@exp
and
@base_exp
) {
@exp
=(
'!:DEFAULT'
);
}
elsif
(
@exp
and !
@base_exp
) {
@base_exp
=(
'!:DEFAULT'
);
}
$wtm
{
$caller
}=[
$wtm
,
$f
,
$l
]
unless
exists
$wtm
{
$caller
};
warn
(
"Ignoring -withtestmore due to a previous call "
.
"($wtm{$caller}->[1]:$wtm{$caller}->[2]) without it "
.
"at $f line $l\n"
)
if
$wtm
{
$caller
}->[0]==0 and
$wtm
==1;
$class
->export_to_level(1,
$class
,
@exp
);
push
@base_exp
,
'!plan'
;
if
(
$wtm
{
$caller
}->[0] ) {
# -withtestmore
eval
<<"EVAL"
package $caller;
#line $l $f
use Test::More import=>\\\@base_exp;
EVAL
}
else
{
# -withouttestmore
eval
<<"EVAL";
package $caller;
#line $l $f
use Test \@base_exp;
EVAL
}
die
$@
if
$@;
}
sub
config {
$Config
||= Apache::TestConfig->thaw->httpd_config;
}
my
$Basic_config
;
# config bits which doesn't require httpd to be found
sub
basic_config {
$Basic_config
||= Apache::TestConfig->thaw();
}
sub
vars {
@_
? @{ config()->{vars} }{
@_
} : config()->{vars};
}
sub
sok (&;$) {
my
$sub
=
shift
;
my
$nok
=
shift
|| 1;
#allow sok to have 'ok' within
my
(
$caller
,
$f
,
$l
)=cp;
if
(
exists
$wtm
{
$caller
} and
$wtm
{
$caller
}->[0]==1) {
# -withtestmore
my
$tb
=Test::Builder->new;
if
(
%SubTests
and not
$SubTests
{ 1+
$tb
->current_test }) {
$tb
->skip(
"skipping this subtest"
)
for
(1..
$nok
);
return
;
}
# trick ok() into reporting the caller filename/line when a
# sub-test fails in sok()
return
eval
<<EOE;
#line $l $f
Test::More::ok(\$sub->());
EOE
}
else
{
if
(
%SubTests
and not
$SubTests
{
$Test::ntest
}) {
skip(
"skipping this subtest"
, 0)
for
(1..
$nok
);
return
;
}
# trick ok() into reporting the caller filename/line when a
# sub-test fails in sok()
return
eval
<<EOE;
#line $l $f
Test::ok(\$sub->());
EOE
}
}
#so Perl's Test.pm can be run inside mod_perl
sub
test_pm_refresh {
my
(
$caller
,
$f
,
$l
)=cp;
if
(
exists
$wtm
{
$caller
} and
$wtm
{
$caller
}->[0]==1) {
# -withtestmore
my
$builder
= Test::Builder->new;
$builder
->
reset
;
$builder
->output(\
*STDOUT
);
$builder
->todo_output(\
*STDOUT
);
# this is STDOUT because Test::More seems to put
# most of the stuff we want on STDERR, so it ends
# up in the error_log instead of where the user can
# see it. consider leaving it alone based on
# later user reports.
$builder
->failure_output(\
*STDOUT
);
}
else
{
# -withouttestmore
unless
(
exists
$wtm
{
$caller
}) {
warn
"You forgot to 'use Apache::Test' in package $caller\n"
;
$wtm
{
$caller
}=[0,
$f
,
$l
];
}
if
(
defined
&Test::_reset_globals
) {
Test::_reset_globals();
# Test.pm uses $TESTOUT=*STDOUT{IO}. We cannot do that
# due to the way SetupEnv works.
$Test::TESTOUT
= \
*STDOUT
;
}
else
{
$Test::TESTOUT
= \
*STDOUT
;
$Test::planned
= 0;
$Test::ntest
= 1;
%Test::todo
= ();
}
}
}
sub
init_test_pm {
my
$r
=
shift
;
# needed to load Apache2::RequestRec::TIEHANDLE
if
(
defined
&Apache2::RequestRec::TIEHANDLE
) {
untie
*STDOUT
;
tie
*STDOUT
,
$r
;
$r
->pool->cleanup_register(
sub
{
untie
*STDOUT
});
}
else
{
$r
->send_http_header;
#1.xx
}
$r
->content_type(
'text/plain'
);
}
sub
plan {
init_test_pm(
shift
)
if
ref
$_
[0];
test_pm_refresh();
# extending Test::plan's functionality, by using the optional
# single value in @_ coming after a ballanced %hash which
# Test::plan expects
if
(
@_
% 2) {
my
$condition
=
pop
@_
;
my
$ref
=
ref
$condition
;
my
$meets_condition
= 0;
if
(
$ref
) {
if
(
$ref
eq
'CODE'
) {
#plan tests $n, \&has_lwp
$meets_condition
=
$condition
->();
}
elsif
(
$ref
eq
'ARRAY'
) {
#plan tests $n, [qw(php4 rewrite)];
$meets_condition
= need_module(
$condition
);
}
else
{
die
"don't know how to handle a condition of type $ref"
;
}
}
else
{
# we have the verdict already: true/false
$meets_condition
=
$condition
? 1 : 0;
}
# trying to emulate a dual variable (ala errno)
unless
(
$meets_condition
) {
my
$reason
=
join
', '
,
@SkipReasons
?
@SkipReasons
:
"no reason given"
;
"1..0 # skipped: $reason\n"
;
@SkipReasons
= ();
# reset
exit
;
#XXX: Apache->exit
}
}
@SkipReasons
= ();
# reset
my
(
$caller
,
$f
,
$l
)=cp;
%SubTests
=();
if
(
my
$subtests
=
$ENV
{HTTPD_TEST_SUBTESTS}) {
%SubTests
=
map
{
$_
, 1 }
split
/\s+/,
$subtests
;
}
if
(
exists
$wtm
{
$caller
} and
$wtm
{
$caller
}->[0]==1) {
# -withtestmore
Test::More::plan(
@_
);
}
else
{
# -withouttestmore
unless
(
exists
$wtm
{
$caller
}) {
warn
"You forgot to 'use Apache::Test' in package $caller\n"
;
$wtm
{
$caller
}=[0,
$f
,
$l
];
}
Test::plan(
@_
);
}
# add to Test.pm verbose output
"# Using Apache/Test.pm version $VERSION\n"
;
}
sub
need_http11 {
if
(Apache::TestRequest::install_http11()) {
return
1;
}
else
{
push
@SkipReasons
,
"LWP version 5.60+ required for HTTP/1.1 support"
;
return
0;
}
}
sub
need_ssl {
my
$vars
= vars();
need_module([
$vars
->{ssl_module_name},
'IO::Socket::SSL'
]);
}
sub
need_lwp {
if
(Apache::TestRequest::has_lwp()) {
return
1;
}
else
{
push
@SkipReasons
,
"libwww-perl is not installed"
;
return
0;
}
}
sub
need {
my
$need_all
= 1;
for
my
$cond
(
@_
) {
if
(
ref
$cond
eq
'HASH'
) {
while
(
my
(
$reason
,
$value
) =
each
%$cond
) {
$value
=
$value
->()
if
ref
$value
eq
'CODE'
;
next
if
$value
;
push
@SkipReasons
,
$reason
;
$need_all
= 0;
}
}
elsif
(
$cond
=~ /^(0|1)$/) {
$need_all
= 0
if
$cond
== 0;
}
else
{
$need_all
= 0
unless
need_module(
$cond
);
}
}
return
$need_all
;
}
sub
need_module {
my
$cfg
= config();
my
@modules
=
grep
defined
$_
,
ref
(
$_
[0]) eq
'ARRAY'
? @{
$_
[0] } :
@_
;
my
@reasons
= ();
for
(
@modules
) {
if
(/^[a-z0-9_.]+$/) {
my
$mod
=
$_
;
$mod
.=
'.c'
unless
$mod
=~ /\.c$/;
next
if
$cfg
->{modules}->{
$mod
};
$mod
=
'mod_'
.
$mod
unless
$mod
=~ /^mod_/;
next
if
$cfg
->{modules}->{
$mod
};
if
(
exists
$cfg
->{cmodules_disabled}->{
$mod
}) {
push
@reasons
,
$cfg
->{cmodules_disabled}->{
$mod
};
next
;
}
}
die
"bogus module name $_"
unless
/^[\w:.]+$/;
# if the module was explicitly passed with a .c extension,
# do not try to eval it as a Perl module
my
$not_found
= 1;
unless
(/\.c$/) {
eval
"require $_"
;
$not_found
= 0
unless
$@;
#print $@ if $@;
}
push
@reasons
,
"cannot find module '$_'"
if
$not_found
;
}
if
(
@reasons
) {
push
@SkipReasons
,
@reasons
;
return
0;
}
else
{
return
1;
}
}
sub
need_min_perl_version {
my
$version
=
shift
;
return
1
if
$] >=
$version
;
push
@SkipReasons
,
"perl >= $version is required"
;
return
0;
}
# currently supports only perl modules
sub
need_min_module_version {
my
(
$module
,
$version
) =
@_
;
# need_module requires the perl module
return
0
unless
need_module(
$module
);
# support dev versions like 0.18_01
return
1
if
eval
{
no
warnings
qw(numeric)
;
$module
->VERSION(
$version
) };
push
@SkipReasons
,
"$module version $version or higher is required"
;
return
0;
}
sub
need_cgi {
return
_need_multi(
qw(cgi.c cgid.c)
);
}
sub
need_cache_disk {
return
_need_multi(
qw(cache_disk.c disk_cache.c)
);
}
sub
need_php {
return
_need_multi(
qw(php4 php5 sapi_apache2.c)
);
}
sub
need_php4 {
return
_need_multi(
qw(php4 sapi_apache2.c)
);
}
sub
need_access {
return
_need_multi(
qw(access authz_host)
);
}
sub
need_auth {
return
_need_multi(
qw(auth auth_basic)
);
}
sub
need_imagemap {
return
need_module(
"imagemap"
) || need_module(
"imap"
);
}
sub
_need_multi {
my
@check
=
@_
;
my
$rc
= 0;
{
local
@SkipReasons
;
foreach
my
$module
(
@check
) {
$rc
||= need_module(
$module
);
}
}
my
$reason
=
join
' or '
,
@check
;
push
@SkipReasons
,
"cannot find one of $reason"
unless
$rc
;
return
$rc
;
}
sub
need_apache {
my
$version
=
shift
;
my
$cfg
= Apache::Test::config();
my
$rev
=
$cfg
->{server}->{rev};
if
(
$rev
==
$version
) {
return
1;
}
else
{
push
@SkipReasons
,
"apache version $version required, this is version $rev"
;
return
0;
}
}
sub
need_min_apache_version {
my
$wanted
=
shift
;
my
$cfg
= Apache::Test::config();
(
my
$current
) =
$cfg
->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;
if
(normalize_vstring(
$current
) < normalize_vstring(
$wanted
)) {
push
@SkipReasons
,
"apache version $wanted or higher is required,"
.
" this is version $current"
;
return
0;
}
else
{
return
1;
}
}
sub
need_min_apache_fix {
my
@wantlevels
=
@_
;
my
$cfg
= Apache::Test::config();
(
my
$current
) =
$cfg
->{server}->{version} =~ m:^Apache/((\d)\.(\d+)\.(\d+)):;
my
$current_major
= $2;
my
$current_minor
= $3;
my
$current_micro
= $4;
foreach
(
@wantlevels
) {
if
(
$_
=~ m/(\d)\.(\d+)\.(\d+)/) {
my
$wanted_major
= $1;
my
$wanted_minor
= $2;
my
$wanted_micro
= $3;
if
(
$wanted_major
eq
$current_major
&&
$wanted_minor
eq
$current_minor
) {
if
(
$wanted_micro
>
$current_micro
) {
push
@SkipReasons
,
"apache version $_ or higher is required,"
.
" this is version $current"
;
return
0;
}
else
{
return
1;
}
}
}
}
# We didn't match major+minor, run the test and let the author sort it out
return
1;
}
sub
need_apache_version {
my
$wanted
=
shift
;
my
$cfg
= Apache::Test::config();
(
my
$current
) =
$cfg
->{server}->{version} =~ m:^Apache/(\d\.\d+\.\d+):;
if
(normalize_vstring(
$current
) != normalize_vstring(
$wanted
)) {
push
@SkipReasons
,
"apache version $wanted or higher is required,"
.
" this is version $current"
;
return
0;
}
else
{
return
1;
}
}
sub
need_apache_mpm {
my
$wanted
=
shift
;
my
$cfg
= Apache::Test::config();
my
$current
=
$cfg
->{server}->{mpm};
if
(
$current
ne
$wanted
) {
push
@SkipReasons
,
"apache $wanted mpm is required,"
.
" this is the $current mpm"
;
return
0;
}
else
{
return
1;
}
}
sub
config_enabled {
my
$key
=
shift
;
defined
$Config
{
$key
} and
$Config
{
$key
} eq
'define'
;
}
sub
need_perl_iolayers {
if
(
my
$ext
=
$Config
{extensions}) {
#XXX: better test? might need to test patchlevel
#if support depends bugs fixed in bleedperl
return
$ext
=~ m:PerlIO/
scalar
:;
}
0;
}
sub
need_perl {
my
$thing
=
shift
;
#XXX: $thing could be a version
my
$config
;
my
$have
= \&{
"need_perl_$thing"
};
if
(
defined
&$have
) {
return
1
if
$have
->();
}
else
{
for
my
$key
(
$thing
,
"use$thing"
) {
if
(
exists
$Config
{
$key
}) {
$config
=
$key
;
return
1
if
config_enabled(
$key
);
}
}
}
push
@SkipReasons
,
$config
?
"Perl was not built with $config enabled"
:
"$thing is not available with this version of Perl"
;
return
0;
}
sub
need_threads {
my
$status
= 1;
# check APR support
my
$build_config
= Apache::TestConfig->modperl_build_config;
if
(
$build_config
) {
my
$apr_config
=
$build_config
->get_apr_config();
unless
(
$apr_config
->{HAS_THREADS}) {
$status
= 0;
push
@SkipReasons
,
"Apache/APR was built without threads support"
;
}
}
# check Perl's useithreads
my
$key
=
'useithreads'
;
unless
(
exists
$Config
{
$key
} and config_enabled(
$key
)) {
$status
= 0;
push
@SkipReasons
,
"Perl was not built with 'ithreads' enabled"
;
}
return
$status
;
}
sub
need_fork {
my
$have_fork
=
$Config
{d_fork} ||
$Config
{d_pseudofork} ||
(($^O eq
'MSWin32'
|| $^O eq
'NetWare'
) &&
$Config
{useithreads} &&
$Config
{ccflags} =~ /-DPERL_IMPLICIT_SYS/);
if
(!
$have_fork
) {
push
@SkipReasons
,
'The fork function is unimplemented'
;
return
0;
}
else
{
return
1;
}
}
sub
under_construction {
push
@SkipReasons
,
"This test is under construction"
;
return
0;
}
sub
skip_reason {
my
$reason
=
shift
||
'no reason specified'
;
push
@SkipReasons
,
$reason
;
return
0;
}
# normalize Apache-style version strings (2.0.48, 0.9.4)
# for easy numeric comparison. note that 2.1 and 2.1.0
# are considered equivalent.
sub
normalize_vstring {
my
@digits
=
shift
=~ m/(\d+)\.?(\d*)\.?(\d*)/;
return
join
''
,
map
{
sprintf
(
"%03d"
,
$_
|| 0) }
@digits
;
}
# have_ functions are the same as need_ but they don't populate
# @SkipReasons
for
my
$func
(
@have
) {
no
strict
'refs'
;
(
my
$real_func
=
$func
) =~ s/^have_/need_/;
*$func
=
sub
{
# be nice to poor souls calling functions with $_ argument in
# the foreach loop, etc.!
local
$_
;
local
@SkipReasons
;
return
$real_func
->(
@_
);
};
}
package
Apache::TestToString;
Apache::Test->
import
(
'!:DEFAULT'
);
sub
TIEHANDLE {
my
$string
=
""
;
bless
\
$string
;
}
sub
PRINT {
my
$string
=
shift
;
$$string
.=
join
''
,
@_
;
}
sub
start {
tie
*STDOUT
, __PACKAGE__;
Apache::Test::test_pm_refresh();
}
sub
finish {
my
$s
;
{
my
$o
=
tied
*STDOUT
;
$s
=
$$o
;
}
untie
*STDOUT
;
$s
;
}
1;
__END__
=head1 NAME
Apache::Test - Test.pm wrapper with helpers for testing Apache
=head1 SYNOPSIS
use Apache::Test;
=head1 DESCRIPTION
B<Apache::Test> is a wrapper around the standard C<Test.pm> with
helpers for testing an Apache server.
=head1 FUNCTIONS
=over 4
=item plan
This function is a wrapper around C<Test::plan>:
plan tests => 3;
just like using Test.pm, plan 3 tests.
If the first argument is an object, such as an C<Apache::RequestRec>
object, C<STDOUT> will be tied to it. The C<Test.pm> global state will
also be refreshed by calling C<Apache::Test::test_pm_refresh>. For
example:
plan $r, tests => 7;
ties STDOUT to the request object C<$r>.
If there is a last argument that doesn't belong to C<Test::plan>
(which expects a balanced hash), it's used to decide whether to
continue with the test or to skip it all-together. This last argument
can be:
=over
=item * a C<SCALAR>
the test is skipped if the scalar has a false value. For example:
plan tests => 5, 0;
But this won't hint the reason for skipping therefore it's better to
use need():
plan tests => 5,
need 'LWP',
{ "not Win32" => sub { $^O eq 'MSWin32'} };
see C<need()> for more info.
=item * an C<ARRAY> reference
need_module() is called for each value in this array. The test is
skipped if need_module() returns false (which happens when at least
one C or Perl module from the list cannot be found).
Watch out for case insensitive file systems or duplicate modules
with the same name. I.E. If you mean mod_env.c
need_module('mod_env.c')
Not
need_module('env')
=item * a C<CODE> reference
the tests will be skipped if the function returns a false value. For
example:
plan tests => 5, need_lwp;
the test will be skipped if LWP is not available
=back
All other arguments are passed through to I<Test::plan> as is.
=item ok
Same as I<Test::ok>, see I<Test.pm> documentation.
=item sok
Allows to skip a sub-test, controlled from the command line. The
argument to sok() is a CODE reference or a BLOCK whose return value
will be passed to ok(). By default behaves like ok(). If all sub-tests
of the same test are written using sok(), and a test is executed as:
% ./t/TEST -v skip_subtest 1 3
only sub-tests 1 and 3 will be run, the rest will be skipped.
=item skip
Same as I<Test::skip>, see I<Test.pm> documentation.
=item test_pm_refresh
Normally called by I<Apache::Test::plan>, this function will refresh
the global state maintained by I<Test.pm>, allowing C<plan> and
friends to be called more than once per-process. This function is not
exported.
=back
Functions that can be used as a last argument to the extended plan().
Note that for each C<need_*> function there is a C<have_*> equivalent
that performs the exact same function except that it is designed to
be used outside of C<plan()>. C<need_*> functions have the side effect
of generating skip messages, if the test is skipped. C<have_*> functions
don't have this side effect. In other words, use C<need_apache()>
with C<plan()> to decide whether a test will run, but C<have_apache()>
within test logic to adjust expectations based on older or newer
server versions.
=over
=item need_http11
plan tests => 5, need_http11;
Require HTTP/1.1 support.
=item need_ssl
plan tests => 5, need_ssl;
Require SSL support.
Not exported by default.
=item need_lwp
plan tests => 5, need_lwp;
Require LWP support.
=item need_cgi
plan tests => 5, need_cgi;
Requires mod_cgi or mod_cgid to be installed.
=item need_cache_disk
plan tests => 5, need_cache_disk
Requires mod_cache_disk or mod_disk_cache to be installed.
=item need_php
plan tests => 5, need_php;
Requires a PHP module to be installed (version 4 or 5).
=item need_php4
plan tests => 5, need_php4;
Requires a PHP version 4 module to be installed.
=item need_imagemap
plan tests => 5, need_imagemap;
Requires a mod_imagemap or mod_imap be installed
=item need_apache
plan tests => 5, need_apache 2;
Requires Apache 2nd generation httpd-2.x.xx
plan tests => 5, need_apache 1;
Requires Apache 1st generation (apache-1.3.xx)
See also C<need_min_apache_version()>.
=item need_min_apache_version
Used to require a minimum version of Apache.
For example:
plan tests => 5, need_min_apache_version("2.0.40");
requires Apache 2.0.40 or higher.
=item need_apache_version
Used to require a specific version of Apache.
For example:
plan tests => 5, need_apache_version("2.0.40");
requires Apache 2.0.40.
=item need_min_apache_fix
Used to require a particular micro version from corresponding minor release
For example:
plan tests => 5, need_min_apache_fix("2.0.40", "2.2.30", "2.4.18");
requires Apache 2.0.40 or higher.
=item need_apache_mpm
Used to require a specific Apache Multi-Processing Module.
For example:
plan tests => 5, need_apache_mpm('prefork');
requires the prefork MPM.
=item need_perl
plan tests => 5, need_perl 'iolayers';
plan tests => 5, need_perl 'ithreads';
Requires a perl extension to be present, or perl compiled with certain
capabilities.
The first example tests whether C<PerlIO> is available, the second
whether:
$Config{useithread} eq 'define';
=item need_min_perl_version
Used to require a minimum version of Perl.
For example:
plan tests => 5, need_min_perl_version("5.008001");
requires Perl 5.8.1 or higher.
=item need_fork
Requires the perl built-in function C<fork> to be implemented.
=item need_module
plan tests => 5, need_module 'CGI';
plan tests => 5, need_module qw(CGI Find::File);
plan tests => 5, need_module ['CGI', 'Find::File', 'cgid'];
Requires Apache C and Perl modules. The function accept a list of
arguments or a reference to a list.
In case of C modules, depending on how the module name was passed it
may pass through the following completions:
=over
=item 1 need_module 'proxy_http.c'
If there is the I<.c> extension, the module name will be looked up as
is, i.e. I<'proxy_http.c'>.
=item 2 need_module 'mod_cgi'
The I<.c> extension will be appended before the lookup, turning it into
I<'mod_cgi.c'>.
=item 3 need_module 'cgi'
The I<.c> extension and I<mod_> prefix will be added before the
lookup, turning it into I<'mod_cgi.c'>.
=back
=item need_min_module_version
Used to require a minimum version of a module
For example:
plan tests => 5, need_min_module_version(CGI => 2.81);
requires C<CGI.pm> version 2.81 or higher.
Currently works only for perl modules.
=item need
plan tests => 5,
need 'LWP',
{ "perl >= 5.8.0 and w/ithreads is required" =>
($Config{useperlio} && $] >= 5.008) },
{ "not Win32" => sub { $^O eq 'MSWin32' },
"foo is disabled" => \&is_foo_enabled,
},
'cgid';
need() is more generic function which can impose multiple requirements
at once. All requirements must be satisfied.
need()'s argument is a list of things to test. The list can include
scalars, which are passed to need_module(), and hash references. If
hash references are used, the keys, are strings, containing a reason
for a failure to satisfy this particular entry, the values are the
condition, which are satisfaction if they return true. If the value is
0 or 1, it used to decide whether the requirements very satisfied, so
you can mix special C<need_*()> functions that return 0 or 1. For
example:
plan tests => 1, need 'Compress::Zlib', 'deflate',
need_min_apache_version("2.0.49");
If the scalar value is a string, different from 0 or 1, it's passed to
I<need_module()>. If the value is a code reference, it gets executed
at the time of check and its return value is used to check the
condition. If the condition check fails, the provided (in a key)
reason is used to tell user why the test was skipped.
In the presented example, we require the presence of the C<LWP> Perl
module, C<mod_cgid>, that we run under perl E<gt>= 5.7.3 on Win32.
It's possible to put more than one requirement into a single hash
reference, but be careful that the keys will be different.
It's also important to mention to avoid using:
plan tests => 1, requirement1 && requirement2;
technique. While test-wise that technique is equivalent to:
plan tests => 1, need requirement1, requirement2;
since the test will be skipped, unless all the rules are satisfied,
it's not equivalent for the end users. The second technique, deploying
C<need()> and a list of requirements, always runs all the requirement
checks and reports all the missing requirements. In the case of the
first technique, if the first requirement fails, the second is not
run, and the missing requirement is not reported. So let's say all the
requirements are missing Apache modules, and a user wants to satisfy
all of these and run the test suite again. If all the unsatisfied
requirements are reported at once, she will need to rebuild Apache
once. If only one requirement is reported at a time, she will have to
rebuild Apache as many times as there are elements in the C<&&>
statement.
Also see plan().
=item under_construction
plan tests => 5, under_construction;
skip all tests, noting that the tests are under construction
=item skip_reason
plan tests => 5, skip_reason('my custom reason');
skip all tests. the reason you specify will be given at runtime.
if no reason is given a default reason will be used.
=back
=head1 Additional Configuration Variables
=over 4
=item basic_config
my $basic_cfg = Apache::Test::basic_config();
$basic_cfg->write_perlscript($file, $content);
C<basic_config()> is similar to C<config()>, but doesn't contain any
httpd-specific information and should be used for operations that
don't require any httpd-specific knowledge.
=item config
my $cfg = Apache::Test::config();
my $server_rev = $cfg->{server}->{rev};
...
C<config()> gives an access to the configuration object.
=item vars
my $serverroot = Apache::Test::vars->{serverroot};
my $serverroot = Apache::Test::vars('serverroot');
my($top_dir, $t_dir) = Apache::Test::vars(qw(top_dir t_dir));
C<vars()> gives an access to the configuration variables, otherwise
accessible as:
$vars = Apache::Test::config()->{vars};
If no arguments are passed, the reference to the variables hash is
returned. If one or more arguments are passed the corresponding values
are returned.
=back
=head1 Test::More Integration
There are a few caveats if you want to use I<Apache::Test> with
I<Test::More> instead of the default I<Test> backend. The first is
that I<Test::More> requires you to use its own C<plan()> function
and not the one that ships with I<Apache::Test>. I<Test::More> also
defines C<ok()> and C<skip()> functions that are different, and
simply C<use>ing both modules in your test script will lead to redefined
warnings for these subroutines.
To assist I<Test::More> users we have created a special I<Apache::Test>
import tag, C<:withtestmore>, which will export all of the standard
I<Apache::Test> symbols into your namespace except the ones that collide
with I<Test::More>.
use Apache::Test qw(:withtestmore);
use Test::More;
plan tests => 1; # Test::More::plan()
ok ('yes', 'testing ok'); # Test::More::ok()
Now, while this works fine for standard client-side tests
(such as C<t/basic.t>), the more advanced features of I<Apache::Test>
require using I<Test::More> as the sole driver behind the scenes.
Should you choose to use I<Test::More> as the backend for
server-based tests (such as C<t/response/TestMe/basic.pm>) you will
need to use the C<-withtestmore> action tag:
use Apache::Test qw(-withtestmore);
sub handler {
my $r = shift;
plan $r, tests => 1; # Test::More::plan() with
# Apache::Test features
ok ('yes', 'testing ok'); # Test::More::ok()
}
C<-withtestmore> tells I<Apache::Test> to use I<Test::More>
instead of I<Test.pm> behind the scenes. Note that you are not
required to C<use Test::More> yourself with the C<-withtestmore>
option and that the C<use Test::More tests =E<gt> 1> syntax
may have unexpected results.
Note that I<Test::More> version 0.49, available within the
I<Test::Simple> 0.49 distribution on CPAN, or greater is required
to use this feature.
Because I<Apache:Test> was initially developed using I<Test> as
the framework driver, complete I<Test::More> integration is
considered experimental at this time - it is supported as best as
possible but is not guaranteed to be as stable as the default I<Test>
interface at this time.
=head1 Apache::TestToString Class
The I<Apache::TestToString> class is used to capture I<Test.pm> output
into a string. Example:
Apache::TestToString->start;
plan tests => 4;
ok $data eq 'foo';
...
# $tests will contain the Test.pm output: 1..4\nok 1\n...
my $tests = Apache::TestToString->finish;
=head1 SEE ALSO
The Apache-Test tutorial:
L<Apache::TestRequest|Apache::TestRequest> subclasses LWP::UserAgent and
exports a number of useful functions for sending request to the Apache test
server. You can then test the results of those requests.
Use L<Apache::TestMM|Apache::TestMM> in your F<Makefile.PL> to set up your
distribution for testing.
=head1 AUTHOR
Doug MacEachern with contributions from Geoffrey Young, Philippe
M. Chiasson, Stas Bekman and others.
Questions can be asked at the test-dev <at> httpd.apache.org list
For more information see: http://httpd.apache.org/test/.
=cut