view release on metacpan or  search on metacpan

lib/Apache/TestRun.pm  view on Meta::CPAN

use Apache::TestRequest ();
use Apache::TestHarness ();
use Apache::TestTrace;

use Cwd;
use ExtUtils::MakeMaker;
use File::Find qw(finddepth);
use File::Path;
use File::Spec::Functions qw(catfile catdir canonpath);
use File::Basename qw(basename dirname);
use Getopt::Long qw(GetOptions);
use Config;

use constant IS_APACHE_TEST_BUILD => Apache::TestConfig::IS_APACHE_TEST_BUILD;

use constant STARTUP_TIMEOUT => 300; # secs (good for extreme debug cases)

use subs qw(exit_shell exit_perl);

my $orig_command;
my $orig_cwd;
my $orig_conf_opts;

my %core_files  = ();

my @std_run      = qw(start-httpd run-tests stop-httpd);
my @others       = qw(verbose configure clean help ssl http11 bugreport
                      save no-httpd one-process);
my @flag_opts    = (@std_run, @others);
my @string_opts  = qw(order trace);
my @ostring_opts = qw(proxy ping);
my @debug_opts   = qw(debug);
my @list_opts    = qw(preamble postamble breakpoint);
my @hash_opts    = qw(header);
my @help_opts    = qw(clean help);
my @request_opts = qw(get post head);

my @exit_opts_no_need_httpd = (@help_opts);
my @exit_opts_need_httpd    = (@debug_opts, qw(ping));

my %usage = (
   'start-httpd'     => 'start the test server',
   'run-tests'       => 'run the tests',
   'order=mode'      => 'run the tests in one of the modes: ' .
                        '(repeat|random|SEED)',
   'stop-httpd'      => 'stop the test server',
   'no-httpd'        => 'run the tests without configuring or starting httpd',
   'verbose[=1]'     => 'verbose output',
   'configure'       => 'force regeneration of httpd.conf ' .
                        ' (tests will not be run)',
   'clean'           => 'remove all generated test files',
   'help'            => 'display this message',
   'bugreport'       => 'print the hint how to report problems',
   'preamble'        => 'config to add at the beginning of httpd.conf',
   'postamble'       => 'config to add at the end of httpd.conf',
   'ping[=block]'    => 'test if server is running or port in use',
   'debug[=name]'    => 'start server under debugger name (gdb, ddd, etc.)',
   'breakpoint=bp'   => 'set breakpoints (multiply bp can be set)',
   'header'          => "add headers to (" .
                         join('|', @request_opts) . ") request",
   'http11'          => 'run all tests with HTTP/1.1 (keep alive) requests',
   'ssl'             => 'run tests through ssl',
   'proxy'           => 'proxy requests (default proxy is localhost)',
   'trace=T'         => 'change tracing default to: warning, notice, ' .
                        'info, debug, ...',
   'one-process'     => 'run the server in single process mode',
   (map { $_, "\U$_\E url" } @request_opts),
);

sub fixup {
    #make sure we use an absolute path to perl
    #else Test::Harness uses the perl in our PATH
    #which might not be the one we want
    $^X = $Config{perlpath} unless -e $^X;
}

# if the test suite was aborted because of a user-error we don't want
# to call the bugreport and invite users to submit a bug report -
# after all it's a user error. but we still want the program to fail,
# so raise this flag in such a case.
my $user_error = 0;
sub user_error {
    my $self = shift;
    $user_error = shift if @_;
    $user_error;
}

sub new {
    my $class = shift;

    my $self = bless {
        tests => [],
        @_,
    }, $class;

    $self->fixup;

    $self;
}

#split arguments into test files/dirs and options
#take extra care if -e, the file matches /\.t$/
#                if -d, the dir contains .t files
#so we dont slurp arguments that are not tests, example:
# httpd $HOME/apache-2.0/bin/httpd

sub split_test_args {
    my($self) = @_;

    my(@tests);
    my $top_dir = $self->{test_config}->{vars}->{top_dir};
    my $t_dir = $self->{test_config}->{vars}->{t_dir};

    my $argv = $self->{argv};
    my @leftovers = ();
    for (@$argv) {
        my $arg = $_;
        # need the t/ (or t\) for stat-ing, but don't want to include
        # it in test output
        $arg =~ s@^(?:\.[\\/])?t[\\/]@@;
        my $file = catfile $t_dir, $arg;