File Coverage

blib/lib/App/Yath.pm

Criterion	Covered	Total	%
statement	95	99	95.9
branch	25	30	83.3
condition	9	12	75.0
subroutine	17	18	94.4
pod	4	5	80.0
total	150	164	91.4

package App::Yath;
use strict;
use warnings;

our $VERSION = '0.000012';

use Test2::Util::HashBase qw/args harness files exclude renderers/;
use Test2::Util qw/pkg_to_file/;

use Test2::Harness;
use Test2::Harness::Parser;
use Test2::Harness::Runner;

use Getopt::Long qw/GetOptionsFromArray/;

sub run {
    my $self = shift;
    my $results = $self->{+HARNESS}->run(@{$self->{+FILES}});

    $_->summary($results) for @{$self->{+RENDERERS}};

    my $failed = grep {!$_->passed} @$results;
    return $failed;
}

sub init {
    my $self = shift;
    $self->{+ARGS} ||= [];
    my @args = @{$self->{+ARGS}};

    my (%env, @libs, @switches);
    my %harness_args = (
        env_vars => \%env,
        libs     => \@libs,
        switches => \@switches,

        parser_class => '+Test2::Harness::Parser',
    );

    my (@exclude, @render, @preload);
    my $color   = -t STDOUT ? 1 : 0;
    my $jobs    = 1;
    my $merge   = 0;
    my $verbose = 0;
    my $quiet   = 0;

    my $runner_class = '+Test2::Harness::Runner';

    Getopt::Long::Configure("bundling");
    GetOptionsFromArray \@args => (
        'l|lib'         => sub {
            push @libs, 'lib';
        },
        'b|blib'        => sub {
            push @libs, 'blib/lib', 'blib/arch';
        },
        'I|include=s@'  => \@libs,
        'R|renderer=s@' => \@render,
        'L|preload=s@'  => \@preload,

        'c|color=i'     => \$color,
        'h|help'        => \&help,
        'j|jobs=i'      => \$jobs,
        'm|merge'       => \$merge,
        'q|quiet'       => \$quiet,
        'v|verbose'     => \$verbose,
        'x|exclude=s@'  => \@exclude,

        'parser|parser_class=s' => \$harness_args{parser_class},
        'runner|runner_class=s' => \$runner_class,

        'S|switch=s@' => sub {
            push @switches => split '=', $_[1];
        },
    ) or die "Could not parse the command line options given.\n";

    die "You cannot combine preload (-L) with switches (-S).\n"
        if @preload && @switches;

    unshift @render => 'EventStream'
        unless $quiet;

    {
        local $ENV{TB_NO_EARLY_INIT} = 1;
        local @INC = (@libs, @INC);
        load_module('', $_) for @preload;
        load_module('Test2::Harness::Runner::', $runner_class) if $runner_class;
        load_module('Test2::Harness::Parser::', $harness_args{parser_class}) if $harness_args{parser_class};
        load_module('Test2::Harness::Renderer::', $_) for @render;
    }

    $harness_args{jobs}   = $jobs;
    $harness_args{runner} = $runner_class->new(merge => $merge, via => @preload ? 'do' : 'open3');

    my @renderers;
    for my $r (@render) {
        push @renderers => $r->new(
            color    => $color,
            parallel => $jobs,
            verbose  => $verbose,
        );
    }

    $harness_args{listeners} = [ map { $_->listen } @renderers ];

    $self->{+RENDERERS} = \@renderers;
    $self->{+HARNESS}   = Test2::Harness->new(%harness_args, verbose => $verbose);

    $self->{+EXCLUDE} = \@exclude;
    $self->{+FILES} = $self->expand_files(@args);
}

sub load_module {
    my $prefix = shift;
    $prefix = '' if $_[0] =~ s/^\+//;
    $_[0] = "${prefix}$_[0]" if $prefix;
    require(pkg_to_file($_[0]));
}

sub expand_files {
    my $self = shift;

    my @in = @_;
    push @in => 't' if !@in && -d 't';

    my (@files, @dirs);
    for my $f (@in) {
        push @files => $f and next if -f $f;
        push @dirs  => $f and next if -d $f;
        die "'$f' is not a valid test file or directory"
    }

    if (@dirs) {
        require File::Find;
        File::Find::find(
            sub {
                no warnings 'once';
                push @files => $File::Find::name if -f $_ & m/\.t2?$/;
            },
            @dirs
        );
    }

    my $exclude = $self->{+EXCLUDE};
    if (@$exclude) {
        @files = grep {
            my $file = $_;
            grep { $file !~ m/$_/ } @$exclude;
        } @files;
    }

    return \@files;
}

sub help {
    my $self = shift;

    print <<"    EOT";
Usage: $0 [OPTIONS] File1 File2 Directory ...

 Common Options:
  -l          --lib               Add lib/ to \@INC.
  -b          --blib              Add blib/lib and blib/arch to \@INC.
  -I[dir]     --include="dir"     Add directories to \@INC.
  -L[Module]  --preload="Module"  Add a module to preload. (Prefork)
  -R[name]    --renderer="name"   Add a renderer. (See [name] section)
  -S[s=val]   --switch="s=val"    Add switches to use when executing perl.
  -c[n]       --color=n           Override the default color level. (0=off)
  -h          --help              Show this usage help.
  -j[n]       --jobs=n            How many tests to run concurrently.
  -m          --merge             Merge STDERR and STDOUT from test files.
  -q          --quiet             Do not use the default renderer.
  -v          --verbose           Show every event, not just failures and diag.
  -x[pattern] --exclude=[pattern] Exclude any files that match the pattern.

 Other Options:
  --parser=[name] --parser_class=[name]   Override the default parser.
  --runner=[name] --runner_class=[name]   Override the default runner.

 [name]
   -R[name] --renderer="name"
    'Test2::Harness::Renderer::[name]' is implied. Prefix with '+' to give an
    absolute module name.

   --parser=[name] --parser_class="name"
    'Test2::Harness::Parser::[name]' is implied. Prefix with '+' to give an
    absolute module name.

   --runner=[name] --runner_class="name"
    'Test2::Harness::Runner::[name]' is implied. Prefix with '+' to give an
    absolute module name.

    EOT

    exit 0;
}

1;

__END__