File Coverage

blib/lib/TAP/SimpleOutput.pm

Criterion	Covered	Total	%
statement	34	48	70.8
branch	4	18	22.2
condition	2	5	40.0
subroutine	14	19	73.6
pod	5	5	100.0
total	59	95	62.1

#
# 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.008-1-gade99b8
$TAP::SimpleOutput::VERSION = '0.009';

# 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 => [ 'counters' ],
        subtest => [ qw{ counters subtest_header subtest_header_needed } ],
    },
};

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


sub counters {
    my $level = shift @_;

    return { _build_counters($level) }
        unless wantarray;

    my $i = 0;
    my @counters =
        grep { $i++ % 2 }
        _build_counters($level)
        ;

    # ditch levelset
    pop @counters;

    return @counters;
}


sub counters_as_hashref { scalar 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 (
        ok       => sub { $indent .     'ok ' . ++$i . " - $_[0]"      },
        nok      => sub { $indent . 'not ok ' . ++$i . " - $_[0]"      },
        skip     => sub { $indent .     'ok ' . ++$i . " # skip $_[0]" },
        plan     => sub { $indent . "1..$i"                            },
        todo     => sub { "$_[0] # TODO $_[1]"                         },
        freeform => sub { $indent . "$_[0]"                            },
        levelset => 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__