view release on metacpan or  search on metacpan

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

my $parent_pid = $$;
sub is_parent { $$ == $parent_pid }

my $caught_sig_int = 0;

sub install_sighandlers {
    my $self = shift;

    my($server, $opts) = ($self->{server}, $self->{opts});

    $SIG{__DIE__} = sub {
        return unless $_[0] =~ /^Failed/i; #dont catch Test::ok failures

        # _show_results() calls die() under a few conditions, such as
        # when no tests are run or when tests fail.  make sure the message
        # is propagated back to the user.
        print $_[0] if (caller(1))[3]||'' eq 'Test::Harness::_show_results';

        $server->stop(1) if $opts->{'start-httpd'};
        $server->failed_msg("error running tests");
        exit_perl 0;
    };

    $SIG{INT} = sub {
        if ($caught_sig_int++) {
            warning "\ncaught SIGINT";
            exit_perl 0;
        }
        warning "\nhalting tests";
        $server->stop if $opts->{'start-httpd'};
        exit_perl 0;
    };

    #try to make sure we scan for core no matter what happens
    #must eval "" to "install" this END block, otherwise it will
    #always run, a subclass might not want that
    eval 'END {
        return unless is_parent(); # because of fork
        $self ||=
            Apache::TestRun->new(test_config => Apache::TestConfig->thaw);
        {
            local $?; # preserve the exit status
            eval {
               $self->scan_core;
            };
        }
        $self->try_bug_report();
    }';
    die "failed: $@" if $@;

}

sub try_bug_report {
    my $self = shift;
    if ($? && !$self->user_error &&
        $self->{opts}->{bugreport} && $self->can('bug_report')) {
        $self->bug_report;
    }
}

#throw away cached config and start fresh
sub refresh {
    my $self = shift;
    $self->opt_clean(1);
    $self->{conf_opts}->{save} = delete $self->{conf_opts}->{thaw} || 1;
    $self->{test_config} = $self->new_test_config()->httpd_config;
    $self->{test_config}->{server}->{run} = $self;
    $self->{server} = $self->{test_config}->server;
}

sub configure_opts {
    my $self = shift;
    my $save = shift;
    my $refreshed = 0;

    my($test_config, $opts) = ($self->{test_config}, $self->{opts});

    $test_config->{vars}->{scheme} =
      $opts->{ssl} ? 'https' :
        $self->{conf_opts}->{scheme} || 'http';

    if ($opts->{http11}) {
        $ENV{APACHE_TEST_HTTP11} = 1;
    }

    # unless we are already reconfiguring, check for .conf.in files changes
    if (!$$save &&
        (my @reasons =
         $self->{test_config}->need_reconfiguration($self->{conf_opts}))) {
        warning "forcing re-configuration:";
        warning "\t- $_." for @reasons;
        unless ($refreshed) {
            $self->refresh;
            $refreshed = 1;
            $test_config = $self->{test_config};
        }
    }

    # unless we are already reconfiguring, check for -proxy
    if (!$$save && exists $opts->{proxy}) {
        my $max = $test_config->{vars}->{maxclients};
        $opts->{proxy} ||= 'on';

        #if config is cached and MaxClients == 1, must reconfigure
        if (!$$save and $opts->{proxy} eq 'on' and $max == 1) {
            $$save = 1;
            warning "server is reconfigured for proxy";
            unless ($refreshed) {
                $self->refresh;
                $refreshed = 1;
                $test_config = $self->{test_config};
            }
        }

        $test_config->{vars}->{proxy} = $opts->{proxy};
    }
    else {
        $test_config->{vars}->{proxy} = 'off';
    }

    return unless $$save;