Apache-Test

 view release on metacpan or  search on metacpan

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

}

#freeze/thaw so other processes can access config

sub thaw {
    my $class = shift;
    $class->new({thaw => 1, @_});
}

sub freeze {
    require Data::Dumper;
    local $Data::Dumper::Terse = 1;
    my $data = Data::Dumper::Dumper(shift);
    chomp $data;
    $data;
}

sub sync_vars {
    my $self = shift;

    return if $self->{save}; #this is not a cached config

    my $changed = 0;

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

$Level = undef;
$LogFH = \*STDERR;

# private data
use constant COLOR   => ($ENV{APACHE_TEST_COLOR} && -t STDOUT) ? 1 : 0;
use constant HAS_COLOR  => eval {
    #XXX: another way to color WINFU terms?
    !(grep { $^O eq $_ } qw(MSWin32 cygwin NetWare)) and
    COLOR and require Term::ANSIColor;
};
use constant HAS_DUMPER => eval { require Data::Dumper;    };

# emerg => 1, alert => 2, crit => 3, ...
my %levels; @levels{@Levels} = 1..@Levels;
$levels{todo} = $levels{debug};
my $default_level = 'info'; # to prevent user typos

my %colors = ();

if (HAS_COLOR) {
    %colors = (

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

    );

    $Term::ANSIColor::AUTORESET = 1;

    for (keys %colors) {
        $colors{$_} = Term::ANSIColor::color($colors{$_});
    }
}

*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] . " : ";

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

There are two more variants of each of these functions. If the
I<_mark> suffix is appended (e.g., I<error_mark>) the trace will start
with the filename and the line number the function was called from. If
the I<_sub> suffix is appended (e.g., I<error_info>) the trace will
start with the name of the subroutine the function was called from.

If you have C<Term::ANSIColor> installed the diagnostic messages will
be colorized, otherwise a special for each function prefix will be
used.

If C<Data::Dumper> is installed and you pass a reference to a variable
to any of these functions, the variable will be dumped with
C<Data::Dumper::Dumper()>.

Functions whose level is above the level set in
C<$Apache::TestTrace::Level> become NOPs. For example if the level is
set to I<alert>, only alert() and emerg() functions will generate the
output. The default setting of this variable is I<warning>. Other
valid values are: I<emerg>, I<alert>, I<crit>, I<error>, I<warning>,
I<notice>, I<info>, I<debug>.

Another way to affect the trace level is to set
C<$ENV{APACHE_TEST_TRACE_LEVEL}>, which takes effect if

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

@EXPORT_OK = qw(t_write_perl_script t_write_shell_script t_chown
                t_catfile_apache t_catfile t_file_watch_for
                t_start_error_log_watch t_finish_error_log_watch
                t_start_file_watch t_read_file_watch t_finish_file_watch);

%CLEAN = ();

$Apache::TestUtil::DEBUG_OUTPUT = \*STDOUT;

# 5.005's Data::Dumper has problems to dump certain datastructures
use constant HAS_DUMPER => eval { $] >= 5.006 && require Data::Dumper; };
use constant INDENT     => 4;

{
    my %files;
    sub t_start_file_watch (;$) {
        my $name = defined $_[0] ? $_[0] : 'error_log';
        $name = File::Spec->catfile(Apache::Test::vars->{t_logs}, $name)
            unless (File::Spec->file_name_is_absolute($name));

        if (open my $fh, '<', $name) {

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

    my @a = (shift, shift);
    if (Apache::TestConfig::WIN32) {
        $a[0] = Win32::GetLongPathName($a[0]) if defined $a[0] && -e $a[0];
        $a[1] = Win32::GetLongPathName($a[1]) if defined $a[1] && -e $a[1];
    }
    return @_ == 1 ? t_cmp($a[0], $a[1], $_[0]) : t_cmp($a[0], $a[1]);
}


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

sub t_debug {
    my $out = $Apache::TestUtil::DEBUG_OUTPUT;
    print $out map {"# $_\n"} map {split /\n/} grep {defined} expand(@_);
}

sub t_open_file {
    my $file = shift;

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

        else {
            die $@;
        }
    }

    CORE::chown($uid, $gid, $file) || die "chown $file: $!";
}

# $string = struct_as_string($indent_level, $var);
#
# return any nested datastructure via Data::Dumper or ala Data::Dumper
# as a string. undef() is a valid arg.
#
# $indent_level should be 0 (used for nice indentation during
# recursive datastructure traversal)
sub struct_as_string{
    return "???"   unless @_ == 2;
    my $level = shift;

    return "undef" unless defined $_[0];
    my $pad  = ' ' x (($level + 1) * INDENT);
    my $spad = ' ' x ($level       * INDENT);

    if (HAS_DUMPER) {
        local $Data::Dumper::Terse = 1;
        $Data::Dumper::Terse = $Data::Dumper::Terse; # warn
        my $data = Data::Dumper::Dumper(@_);
        $data =~ s/\n$//; # \n is handled by the caller
        return $data;
    }
    else {
        if (ref($_[0]) eq 'ARRAY') {
            my @data = ();
            for my $i (0..$#{ $_[0] }) {
                push @data,
                    struct_as_string($level+1, $_[0]->[$i]);
            }