File Coverage

blib/lib/TAP/SimpleOutput.pm

Criterion	Covered	Total	%
statement	31	45	68.8
branch	2	16	12.5
condition	2	5	40.0
subroutine	14	19	73.6
pod	5	5	100.0
total	54	90	60.0

#
# This file is part of TAP-SimpleOutput
#
# This software is Copyright (c) 2012 by Chris Weyl.
#
# This is free software, licensed under:
#
#   The GNU Lesser General Public License, Version 2.1, February 1999
#
package TAP::SimpleOutput;
our $AUTHORITY = 'cpan:RSRCHBOY';
# git description: 0.005-1-g84db602
$TAP::SimpleOutput::VERSION = '0.006'; # TRIAL

# ABSTRACT: Simple closure-driven TAP generator

use strict;
use warnings;

use Sub::Exporter::Progressive -setup => {
    exports => [ qw{
        counters counters_and_levelset counters_as_hashref
        subtest_header subtest_header_needed
    } ],
    groups => {
        default => [],
        subtest => [ qw{ subtest_header subtest_header_needed } ],
    },
};

use Carp 'croak';
use Class::Load 'try_load_class';


sub counters {
    my @counters = _build_counters(@_);
    pop @counters;
    return @counters;
}


sub counters_as_hashref {
    my @counters = _build_counters(@_);

    return {
        ok       => shift @counters,
        nok      => shift @counters,
        skip     => shift @counters,
        plan     => shift @counters,
        todo     => shift @counters,
        freeform => shift @counters,
    };
}


sub counters_and_levelset { goto \&_build_counters }

sub _build_counters {
    my $level = shift @_ || 0;
    $level *= 4;
    my $i = 0;

    my $indent = !$level ? q{} : (' ' x $level);

    return (
        sub { $indent .     'ok ' . ++$i . " - $_[0]"      }, # ok
        sub { $indent . 'not ok ' . ++$i . " - $_[0]"      }, # nok
        sub { $indent .     'ok ' . ++$i . " # skip $_[0]" }, # skip
        sub { $indent . "1..$i"                            }, # plan
        sub { "$_[0] # TODO $_[1]"                         }, # todo
        sub { $indent . "$_[0]"                            }, # freeform
        sub {
            # if we're called with a new level, set $level and $indent
            # appropriately
            do { $level = $_[0] * 4; $indent = !$level ? q{} : (' ' x $level) }
                if defined $_[0];

            # return our new/set level regardless, in the form we passed it in
            return $level / 4;
        },
    );
}


my $_subtest_header_needed;
sub subtest_header_needed {

    return $_subtest_header_needed
        if defined $_subtest_header_needed;

    do {
        my ($success, $error) = try_load_class $_;
        croak __PACKAGE__ . " needs $_, but can't find it: $error"
            unless $success;
    } for qw{ Perl::Version Test::More };

    return $_subtest_header_needed
        = Perl::Version->new(Test::More->VERSION) >= Perl::Version->new('0.98_05');
}

sub _subtest_header_indent { $INC{'Test/Stream.pm'} ? q{} : (' ' x 4) }


sub subtest_header {
    my ($out, $name) = @_;

    $out = $out->{freeform}
        if ref $out && ref $out eq 'HASH';

    return subtest_header_needed()
        ? $out->(_subtest_header_indent . "# Subtest: $name")
        : q{}
        ;
}

!!42;

__END__