view release on metacpan or  search on metacpan

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

        }
        elsif ($ref_a eq 'HASH' && $ref_b eq 'HASH') {
            return 0 unless (keys %$a) == (keys %$b);
            for my $key (sort keys %$a) {
                return 0 unless exists $b->{$key};
                t_is_equal($a->{$key}, $b->{$key}) || return 0;
            }
        }
        elsif ($ref_b eq 'Regexp') {
            return $a =~ $b;
        }
        else {
            # try to compare the references
            return $a eq $b;
        }
    }
    else {
        # undef == undef! a valid test
        return (defined $a || defined $b) ? 0 : 1;
    }
    return 1;
}



sub t_cmp ($$;$) {
    Carp::carp(join(":", (caller)[1..2]) .
        ' usage: $res = t_cmp($received, $expected, [$comment])')
            if @_ < 2 || @_ > 3;

    my ($received, $expected) = @_;

    # this was added in Apache::Test::VERSION 1.12 - remove deprecated
    # logic sometime around 1.15 or mid September, 2004.
    if (UNIVERSAL::isa($_[0], 'Regexp')) {
        my @warning = ("WARNING!!! t_cmp() argument order has changed.",
                       "use of a regular expression as the first argument",
                       "is deprecated.  support will be removed soon.");
        t_debug(@warning);
        ($received, $expected) = ($expected, $received);
    }

    t_debug("testing : " . pop) if @_ == 3;
    t_debug("expected: " . struct_as_string(0, $expected));
    t_debug("received: " . struct_as_string(0, $received));
    return t_is_equal($received, $expected);
}

# Essentially t_cmp, but on Win32, first converts pathnames
# to their DOS long name.
sub t_filepath_cmp ($$;$) {
    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;

    die "must pass a filename" unless defined $file;

    # create the parent dir if it doesn't exist yet
    makepath(dirname $file);

    my $fh = Symbol::gensym();
    open $fh, ">$file" or die "can't open $file: $!";
    t_debug("writing file: $file");
    $CLEAN{files}{$file}++;

    return $fh;
}

sub _temp_package_dir {
    return catdir(tmpdir(), 'apache_test');
}

sub t_write_test_lib {
    my $file = shift;

    die "must pass a filename" unless defined $file;

    t_write_file(catdir(_temp_package_dir(), $file), @_);
}

sub t_write_file {
    my $file = shift;

    die "must pass a filename" unless defined $file;

    # create the parent dir if it doesn't exist yet
    makepath(dirname $file);

    my $fh = Symbol::gensym();
    open $fh, ">$file" or die "can't open $file: $!";
    t_debug("writing file: $file");
    print $fh join '', @_ if @_;
    close $fh;
    $CLEAN{files}{$file}++;
}

sub t_append_file {
    my $file = shift;

    die "must pass a filename" unless defined $file;

    # create the parent dir if it doesn't exist yet
    makepath(dirname $file);

    # add to the cleanup list only if we created it now
    $CLEAN{files}{$file}++ unless -e $file;

    my $fh = Symbol::gensym();
    open $fh, ">>$file" or die "can't open $file: $!";
    print $fh join '', @_ if @_;