view release on metacpan or  search on metacpan

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

        }
    }

    # breakpoint automatically turns the debug mode on
    if (@{ $opts{breakpoint} }) {
        $opts{debug} ||= 1;
    }

    if ($self->{reconfigure}) {
        $conf_opts{save} = 1;
        delete $self->{reconfigure};
    }
    else {
        $conf_opts{thaw} = 1;
    }

    #propagate some values
    for (qw(verbose)) {
        $conf_opts{$_} = $opts{$_};
    }

    $self->{opts} = \%opts;
    $self->{conf_opts} = \%conf_opts;
}

sub default_run_opts {
    my $self = shift;
    my($opts, $tests) = ($self->{opts}, $self->{tests});

    unless (grep { exists $opts->{$_} } @std_run, @request_opts) {
        if (@$tests && $self->{server}->ping) {
            # if certain tests are specified and server is running,
            # dont restart
            $opts->{'run-tests'} = 1;
        }
        else {
            #default is start-server run-tests stop-server
            $opts->{$_} = 1 for @std_run;
        }
    }

    $opts->{'run-tests'} ||= @$tests;
}

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});