File Coverage

blib/lib/App/NDTools/Test.pm

Criterion	Covered	Total	%
statement	54	65	83.0
branch	25	34	73.5
condition	11	21	52.3
subroutine	10	12	83.3
pod	0	4	0.0
total	100	136	73.5

package App::NDTools::Test;

use strict;
use warnings FATAL => 'all';
use parent qw(Exporter);

use Capture::Tiny qw(capture);
use Data::Dumper;
use Test::More;

our @EXPORT = qw(
    run_ok
    t_ab_cmp
    t_dir
    t_dump
);

sub run_ok {
    my %t = @_;

    local $Test::Builder::Level = $Test::Builder::Level + 1;

    if (exists $t{skip} and $t{skip}->()) {
        pass("Test '$t{name}' cancelled by 'skip' opt");
        return;
    }

    my @envs = exists $t{env} ? %{$t{env}} : ();
    SET_ENV: # can't use loop here - env vars will be localized in it's block
    @envs and local $ENV{$envs[0]} = $envs[1];
    if (@envs) {
        splice @envs, 0, 2;
        goto SET_ENV;
    }

    if (exists $t{pre} and not $t{pre}->()) {
        fail("Pre hook for '$t{name}' failed");
        return;
    }

    my ($out, $err, $exit) = capture { system(@{$t{cmd}}) };

    subtest $t{name} => sub {

        for my $std ('stdout', 'stderr') {
            next if (exists $t{$std} and not defined $t{$std}); # set to undef to skip test
            $t{$std} = '' unless (exists $t{$std});             # silence expected by default

            my $desc = uc($std) . " check for $t{name}: [" . join(" ", @{$t{cmd}}) ."]";
            my $data = $std eq 'stdout' ? $out : $err;

            if (ref $t{$std} eq 'CODE') {
                ok($t{$std}->($data), $desc);
            } elsif (ref $t{$std} eq 'Regexp') {
                like($data, $t{$std}, $desc);
            } else {
                is($data, $t{$std}, $desc);
            }
        }

        if (not exists $t{exit} or defined $t{exit}) {  # set to undef to skip test
            $t{exit} = 0 unless exists $t{exit};        # defailt exit code
            is(
                $exit >> 8, $t{exit},
                "Exit code check for $t{name}: [" . join(" ", @{$t{cmd}}) ."]"
            );
        }

        $t{test}->() if (exists $t{test});

        if (exists $t{post} and not $t{post}->()) {
            fail("Post hook for '$t{name}' failed");
            return;
        }

        if (not exists $t{clean} or defined $t{clean}) { # set to undef to skip
            @{$t{clean}} = "$t{name}.got" unless exists $t{clean};
            map { unlink $_ if (-f $_) } @{$t{clean}};
        }

        done_testing();
    }
}

sub t_ab_cmp {
    return "GOT: " . t_dump(shift) . "\nEXP: " . t_dump(shift);
}

sub t_dir {
    my $tfile = shift || (caller)[1];
    substr($tfile, 0, length($tfile) - 1) . "d";
}

sub t_dump {
    return Data::Dumper->new([shift])->Terse(1)->Sortkeys(1)->Quotekeys(0)->Indent(0)->Deepcopy(1)->Dump();
}

1;