File Coverage

blib/lib/Test/Roo/DataDriven.pm

Criterion	Covered	Total	%
statement	66	70	94.2
branch	18	24	75.0
condition	14	24	58.3
subroutine	11	12	91.6
pod	2	2	100.0
total	111	132	84.0

package Test::Roo::DataDriven;

# ABSTRACT: simple data-driven tests with Test::Roo

# RECOMMEND PREREQ: App::Prove
# RECOMMEND PREREQ: Ref::Util::XS

use v5.8;

use Test::Roo::Role;

use curry;

use Class::Unload;
use Path::Tiny;
use Ref::Util qw/ is_arrayref is_hashref /;

use namespace::autoclean;

requires 'run_tests';

our $VERSION = 'v0.4.0';


sub _build_data_files {
    my ( $class, $args ) = @_;

    my $match = $args->{match} || qr/\.dat$/;

    my @paths;
    my @files;

    my $argv = defined $args->{argv} ? $args->{argv} : 1;
    if ( $argv && @ARGV ) {
        @paths = map { path($_) } @ARGV;
    }
    else {
        @paths =
          map { path($_) } is_arrayref( $args->{files} )
          ? @{ $args->{files} }
          : ( $args->{files} );
    }

    foreach my $path (@paths) {

        die "Path $path does not exist" unless $path->exists;

        if ( $path->is_dir ) {

            my $iter = $path->iterator(
                {
                    recurse         => $args->{recurse}         || 0,
                    follow_symlinks => $args->{follow_symlinks} || 0,
                }
            );

            while ( my $file = $iter->() ) {
                next unless $file->basename =~ $match;
                push @files, $file;
            }

        }
        else {

            push @files, $path;

        }

    }

    return [ sort @files ];
}


sub run_data_tests {
    my ( $class, @args ) = @_;

    my %args =
      ( ( @args == 1 ) && is_hashref( $args[0] ) )
      ? %{ $args[0] }
      : @args;

    my $filter = $args{filter} || sub { $_[0] };
    my $parser = $args{parser} || $class->curry::parse_data_file;

    foreach my $file ( @{ $class->_build_data_files( \%args ) } ) {

        note "Data: $file";

        my $data = $parser->($file);

        if ( is_arrayref($data) ) {

            my @cases = @$data;
            my $i     = 0;

            foreach my $case (@cases) {

                my $desc = sprintf(
                    '%s (%u of %u)',
                    $case->{description} || $file->basename,    #
                    ++$i,                                       #
                    scalar(@cases)                              #
                );

                $class->run_tests( $desc, $filter->( $case, $file, $i ) );

            }

        }
        elsif ( is_hashref($data) ) {

            my $desc = $data->{description} || $file->basename;

            $class->run_tests( $desc, $filter->( $data, $file ) );
        }
        else {

            my $type = ref $data;
            die "unsupported data type ${type} returned by ${file}";

        }

    }

}


my $Counter = 0;

sub parse_data_file {
    my ( $class, $file ) = @_;

    my $path = $file->absolute;

    my $eval = sub { eval $_[0] };    ## no critic (ProhibitStringyEval)

    my $package = __PACKAGE__ . "::Sandbox" . $Counter++;

    my $data = $eval->("package ${package}; do q{${path}} or die \$!;");

    die "parse failed on $file: $@" if $@;
    die "do failed on $file: $!" unless defined $data;
    die "run failed or no data returned on $file" unless $data;

    Class::Unload->unload($package);

    return $data;
}


1;

__END__