view release on metacpan or  search on metacpan

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

    $warning .= "generated on $time\n";
    $warning .= calls_trace();
    return $self->warn_style_sub_ref($filename)->($warning);
}

sub calls_trace {
    my $frame = 1;
    my $trace = '';

    while (1) {
        my($package, $filename, $line) = caller($frame);
        last unless $filename;
        $trace .= sprintf "%02d: %s:%d\n", $frame, $filename, $line;
        $frame++;
    }

    return $trace;
}

sub clean_add_file {
    my($self, $file) = @_;

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

    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;

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

}

*expand = HAS_DUMPER ?
    sub { map { ref $_ ? Data::Dumper::Dumper($_) : $_ } @_ } :
    sub { @_ };

sub prefix {
    my $prefix = shift;

    if ($prefix eq 'mark') {
        return join(":", (caller(3))[1..2]) . " : ";
    }
    elsif ($prefix eq 'sub') {
        return (caller(3))[3] . " : ";
    }
    else {
        return '';
    }
}

sub c_trace {
    my ($level, $prefix_type) = (shift, shift);
    my $prefix = prefix($prefix_type);
    print $LogFH