1package TAP::Formatter::Color;
2
3use strict;
4use warnings;
5
6use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
7
8use base 'TAP::Object';
9
10my $NO_COLOR;
11
12BEGIN {
13    $NO_COLOR = 0;
14
15    eval 'require Term::ANSIColor';
16    if ($@) {
17        $NO_COLOR = $@;
18    };
19    if (IS_WIN32) {
20        eval 'use Win32::Console::ANSI';
21        if ($@) {
22            $NO_COLOR = $@;
23        }
24    };
25
26    if ($NO_COLOR) {
27        *set_color = sub { };
28    } else {
29        *set_color = sub {
30            my ( $self, $output, $color ) = @_;
31            $output->( Term::ANSIColor::color($color) );
32        };
33    }
34}
35
36=head1 NAME
37
38TAP::Formatter::Color - Run Perl test scripts with color
39
40=head1 VERSION
41
42Version 3.48
43
44=cut
45
46our $VERSION = '3.48';
47
48=head1 DESCRIPTION
49
50Note that this harness is I<experimental>.  You may not like the colors I've
51chosen and I haven't yet provided an easy way to override them.
52
53This test harness is the same as L<TAP::Harness>, but test results are output
54in color.  Passing tests are printed in green.  Failing tests are in red.
55Skipped tests are blue on a white background and TODO tests are printed in
56white.
57
58If L<Term::ANSIColor> cannot be found (and L<Win32::Console::ANSI> if running
59under Windows) tests will be run without color.
60
61=head1 SYNOPSIS
62
63 use TAP::Formatter::Color;
64 my $harness = TAP::Formatter::Color->new( \%args );
65 $harness->runtests(@tests);
66
67=head1 METHODS
68
69=head2 Class Methods
70
71=head3 C<new>
72
73The constructor returns a new C<TAP::Formatter::Color> object. If
74L<Term::ANSIColor> is not installed, returns undef.
75
76=cut
77
78# new() implementation supplied by TAP::Object
79
80sub _initialize {
81    my $self = shift;
82
83    if ($NO_COLOR) {
84
85        # shorten that message a bit
86        ( my $error = $NO_COLOR ) =~ s/ in \@INC .*//s;
87        warn "Note: Cannot run tests in color: $error\n";
88        return;    # abort object construction
89    }
90
91    return $self;
92}
93
94##############################################################################
95
96=head3 C<can_color>
97
98  Test::Formatter::Color->can_color()
99
100Returns a boolean indicating whether or not this module can actually
101generate colored output. This will be false if it could not load the
102modules needed for the current platform.
103
104=cut
105
106sub can_color {
107    return !$NO_COLOR;
108}
109
110=head3 C<set_color>
111
112Set the output color.
113
114=cut
115
1161;
117