File Coverage

blib/lib/Test/Files.pm

Criterion	Covered	Total	%
statement	196	199	98.4
branch	57	60	95.0
condition	5	6	83.3
subroutine	19	19	100.0
pod	7	8	87.5
total	284	292	97.2

package Test::Files;
use Test::Builder;
use Text::Diff;
use File::Find;
use File::Spec;

use strict;
use warnings;  # This is off in Test::More, eventually it may have to go.

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT = qw(
    file_ok
    file_filter_ok
    compare_ok
    compare_filter_ok
    dir_contains_ok
    dir_only_contains_ok
    compare_dirs_ok
    compare_dirs_filter_ok
);

our $VERSION = '0.14';

my $Test = Test::Builder->new;
my $diff_options = {
    CONTEXT     => 3,          # change this one later if needed
    STYLE       => "Table",
    FILENAME_A  => "Got",
    FILENAME_B  => "Expected",
    OFFSET_A    => 1,
    OFFSET_B    => 1,
    INDEX_LABEL => "Ln",
    MTIME_A     => "",
    MTIME_B     => "",
};

sub file_ok {
    my $candidate_file = shift;
    my $expected       = shift;
    my $name           = shift;

    unless (-f $candidate_file and -r _) {
        $Test->ok(0, $name);
        $Test->diag("$candidate_file absent");
        return;
    }

    # chomping and reappending the line ending was done in
    # Test::Differences::eq_or_diff
    my $diff = diff($candidate_file, \$expected, $diff_options);
    chomp $diff;
    my $failed = length $diff;
    $diff .= "\n";

    if ($failed) {
        $Test->ok(0, $name);
        $Test->diag($diff);
    }
    else {
        $Test->ok(1, $name);
    }
}

sub file_filter_ok {
    my $candidate_file = shift;
    my $expected       = shift;
    my $filter         = shift;
    my $name           = shift;

    unless (open CANDIDATE, "$candidate_file") {
        $Test->ok(0, $name);
        $Test->diag( "$candidate_file absent" );
        return;
    }

    my $candidate = _read_and_filter_handle( *CANDIDATE, $filter );

    # chomping and reappending the line ending was done in
    # Test::Differences::eq_or_diff
    my $diff = diff(\$candidate, \$expected, $diff_options);
    chomp $diff;
    my $failed = length $diff;
    $diff .= "\n";

    if ($failed) {
        $Test->ok(0, $name);
        $Test->diag($diff);
    }
    else {
        $Test->ok(1, $name);
    }
}

sub _read_two_files {
    my $first   = shift;
    my $second  = shift;
    my $filter  = shift;
    my $success = 1;
    my @errors;

    unless (open FIRST, "$first") {
        $success = 0;
        push @errors, "$first absent";
    }
    unless (open SECOND, "$second") {
        $success = 0;
        push @errors, "$second absent";
    }
    return ($success, @errors) unless $success;

    my $first_data  = _read_and_filter_handle(*FIRST,  $filter);
    my $second_data = _read_and_filter_handle(*SECOND, $filter);
    close FIRST;
    close SECOND;

    return ($success, $first_data, $second_data);
}

sub _read_and_filter_handle {
    my $handle = shift;
    my $filter = shift;

    if ($filter) {
        my @retval;
        while (<$handle>) {
            my $filtered = $filter->($_);
            push @retval, $filtered if $filtered;
        }
        return join "", @retval;
    }
    else {
        return join "", <$handle>;
    }
}

sub compare_ok {
    my $got_file      = shift;
    my $expected_file = shift;
    my $name          = shift;

    @_ = ($got_file, $expected_file, undef, $name);
    goto &compare_filter_ok;
}

sub compare_filter_ok {
    my $got_file      = shift;
    my $expected_file = shift;
    my $filter        = shift;
    my $name          = shift;
    my @read_result   = _read_two_files($got_file, $expected_file, $filter);
    my $files_exist   = shift @read_result;

    if ($files_exist) {
        my ($got, $expected) = @read_result;
        # chomping and reappending the line ending was done in
        # Test::Differences::eq_or_diff
        my $diff = diff(\$got, \$expected, $diff_options);
        chomp $diff;
        my $failed = length $diff;
        $diff .= "\n";

        if ($failed) {
            $Test->ok(0, $name);
            $Test->diag($diff);
        }
        else {
            $Test->ok(1, $name);
        }
    }
    else {
        $Test->ok(0, $name);
        $Test->diag(join "\n", @read_result);
    }
}

sub _dir_missing_helper {
    my $base_dir = shift;
    my $list     = shift;
    my $name     = shift;
    my $function = shift;

    unless (-d $base_dir) {
        return(0, "$base_dir absent");
    }
    if (index(ref $list, 'ARRAY') < 0) {
        return(0, "$function requires array ref as second arg");
        return;
    }

    my @missing;
    foreach my $element (@$list) {
        my $elem_path = File::Spec->catfile( $base_dir, $element );
        push @missing, $element unless (-e $elem_path );
    }
    return (\@missing);
}

sub dir_contains_ok {
    my $base_dir = shift;
    my $list     = shift;
    my $name     = shift;
    my @result   = _dir_missing_helper(
        $base_dir, $list, $name, 'dir_contains_ok'
    );
    if (@result == 2) {
        $Test->ok(0, $name);
        $Test->diag($result[1]);
        return;
    }

    my $missing = $result[0];

    if (@$missing) {
        $Test->ok(0, $name);
        $Test->diag("failed to see these: @$missing");
    }
    else {
        $Test->ok(1, $name);
    }
}

sub dir_only_contains_ok {
    my $base_dir = shift;
    my $list     = shift;
    my $name     = shift;
    my @result   = _dir_missing_helper(
        $base_dir, $list, $name, 'dir_only_contains_ok'
    );
    if (@result == 2) {
        $Test->ok(0, $name);
        $Test->diag($result[1]);
        return;
    }

    my $missing = $result[0];

    my $success;
    my @diags;
    if (@$missing) {
        $success = 0;
        push @diags, "failed to see these: @$missing";
    }
    else {
        $success = 1;
    }

    # Then, make sure no other files are present.
    my %expected;
    my @unexpected;
    @expected{ @$list } = ();
    # by defining $contains here, it can use our scope
    my $contains = sub {
        my $name = $File::Find::name;
        return if ($name eq $base_dir);
        $name    = File::Spec->abs2rel( $name, $base_dir );
        push @unexpected, $name unless (exists $expected{$name});
    };

    find($contains, ($base_dir));

    if (@unexpected) {
        $success  = 0;
        my $unexp = @unexpected;
        push @diags, "unexpectedly saw: @unexpected";
    }

    $Test->ok($success, $name);
    $Test->diag(join "\n", @diags) if @diags;
}

sub compare_dirs_ok {
    my $first_dir  = shift;
    my $second_dir = shift;
    my $name       = shift;

    @_ = ($first_dir, $second_dir, undef, $name);
    goto &compare_dirs_filter_ok;
}

sub compare_dirs_filter_ok {
    my $first_dir  = shift;
    my $second_dir = shift;
    my $filter     = shift;
    my $name       = shift;

    unless (-d $first_dir) {
        $Test->ok(0, $name);
        $Test->diag("$first_dir is not a valid directory");
        return;
    }
    unless (-d $second_dir) {
        $Test->ok(0, $name);
        $Test->diag("$second_dir is not a valid directory");
        return;
    }
    unless (not defined $filter or ref($filter) =~ /CODE/) {
        $Test->ok(0, $filter);
        $Test->diag(
            "Third argument to compare_dirs_filter_ok must be "
            . "a code reference (or undef)"
        );
        return;
    }

    my @diags;

    my $matches = sub {
        my $name = $File::Find::name;

        return if (-d $name);

        $name    = File::Spec->abs2rel( $name, $first_dir );
        return if length($name) < 1;  # skip the base directory

        my $first_file  = File::Spec->catfile( $first_dir,  $name );
        my $second_file = File::Spec->catfile( $second_dir, $name );

        my @result = _read_two_files(
            $first_file, $second_file, $filter
        );
        my $files_exist = shift @result;

        if ($files_exist) {
            my ($got, $expected) = @result;
            my $diff = diff(
                \$got,
                \$expected,
                {
                    %$diff_options,
                    FILENAME_A => $first_file,
                    FILENAME_B => $second_file,
                }
            );
            chomp $diff;
            my $failed = length $diff;
            $diff .= "\n";

            if ($failed) {
                push @diags, $diff;
            }
        }
        else {
            push @diags, "$result[0]\n";
        }
    };

    find({ wanted => $matches, no_chdir => 1 }, $first_dir);

    if (@diags) {
        $Test->ok(0, $name);
        $Test->diag(sort @diags);
    }
    else {
        $Test->ok(1, $name);
    }
}

1;
__END__