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


line stmt bran cond sub pod time code
1             #
2             # This file is part of TAP-SimpleOutput
3             #
4             # This software is Copyright (c) 2012 by Chris Weyl.
5             #
6             # This is free software, licensed under:
7             #
8             # The GNU Lesser General Public License, Version 2.1, February 1999
9             #
10             package TAP::SimpleOutput;
11             our $AUTHORITY = 'cpan:RSRCHBOY';
12             # git description: 0.008-1-gade99b8
13             $TAP::SimpleOutput::VERSION = '0.009';
14              
15             # ABSTRACT: Simple closure-driven TAP generator
16              
17 1     1   13553 use strict;
  1         2  
  1         25  
18 1     1   3 use warnings;
  1         1  
  1         44  
19              
20 1         9 use Sub::Exporter::Progressive -setup => {
21             exports => [ qw{
22             counters counters_and_levelset counters_as_hashref
23             subtest_header subtest_header_needed
24             } ],
25             groups => {
26             default => [ 'counters' ],
27             subtest => [ qw{ counters subtest_header subtest_header_needed } ],
28             },
29 1     1   394 };
  1         699  
30              
31 1     1   107 use Carp 'croak';
  1         1  
  1         75  
32 1     1   381 use Class::Load 'try_load_class';
  1         14502  
  1         433  
33              
34              
35             sub counters {
36 6     6 1 17 my $level = shift @_;
37              
38 6 100       14 return { _build_counters($level) }
39             unless wantarray;
40              
41 4         4 my $i = 0;
42             my @counters =
43 4         10 grep { $i++ % 2 }
  56         50  
44             _build_counters($level)
45             ;
46              
47             # ditch levelset
48 4         5 pop @counters;
49              
50 4         20 return @counters;
51             }
52              
53              
54 1     1 1 3 sub counters_as_hashref { scalar counters }
55              
56              
57 0     0 1 0 sub counters_and_levelset { goto \&_build_counters }
58              
59             sub _build_counters {
60 6   100 6   19 my $level = shift @_ || 0;
61 6         5 $level *= 4;
62 6         4 my $i = 0;
63              
64 6 100       15 my $indent = !$level ? q{} : (' ' x $level);
65              
66             return (
67 19     19   83 ok => sub { $indent . 'ok ' . ++$i . " - $_[0]" },
68 5     5   14 nok => sub { $indent . 'not ok ' . ++$i . " - $_[0]" },
69 5     5   19 skip => sub { $indent . 'ok ' . ++$i . " # skip $_[0]" },
70 5     5   17 plan => sub { $indent . "1..$i" },
71 5     5   8 todo => sub { "$_[0] # TODO $_[1]" },
72 4     4   12 freeform => sub { $indent . "$_[0]" },
73             levelset => sub {
74             # if we're called with a new level, set $level and $indent
75             # appropriately
76 0 0   0     do { $level = $_[0] * 4; $indent = !$level ? q{} : (' ' x $level) }
  0 0          
  0            
77             if defined $_[0];
78              
79             # return our new/set level regardless, in the form we passed it in
80 0           return $level / 4;
81             },
82 6         64 );
83             }
84              
85              
86             my $_subtest_header_needed;
87             sub subtest_header_needed {
88              
89 0 0   0 1   return $_subtest_header_needed
90             if defined $_subtest_header_needed;
91              
92             do {
93 0           my ($success, $error) = try_load_class $_;
94 0 0         croak __PACKAGE__ . " needs $_, but can't find it: $error"
95             unless $success;
96 0           } for qw{ Perl::Version Test::More };
97              
98 0           return $_subtest_header_needed
99             = Perl::Version->new(Test::More->VERSION) >= Perl::Version->new('0.98_05');
100             }
101              
102 0 0   0     sub _subtest_header_indent { $INC{'Test/Stream.pm'} ? q{} : (' ' x 4) }
103              
104              
105             sub subtest_header {
106 0     0 1   my ($out, $name) = @_;
107              
108             $out = $out->{freeform}
109 0 0 0       if ref $out && ref $out eq 'HASH';
110              
111 0 0         return subtest_header_needed()
112             ? $out->(_subtest_header_indent . "# Subtest: $name")
113             : q{}
114             ;
115             }
116              
117             !!42;
118              
119             __END__