File Coverage

blib/lib/Pod/Text/Color.pm
Criterion Covered Total %
statement 43 47 91.4
branch 1 2 50.0
condition 1 3 33.3
subroutine 13 14 92.8
pod 0 8 0.0
total 58 74 78.3


line stmt bran cond sub pod time code
1             # Pod::Text::Color -- Convert POD data to formatted color ASCII text
2             #
3             # This is just a basic proof of concept. It should later be modified to make
4             # better use of color, take options changing what colors are used for what
5             # text, and the like.
6             #
7             # Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2014
8             # Russ Allbery
9             #
10             # This program is free software; you may redistribute it and/or modify it
11             # under the same terms as Perl itself.
12              
13             ##############################################################################
14             # Modules and declarations
15             ##############################################################################
16              
17             package Pod::Text::Color;
18              
19 2     2   6645 use 5.006;
  2         4  
20 2     2   6 use strict;
  2         3  
  2         29  
21 2     2   5 use warnings;
  2         2  
  2         33  
22              
23 2     2   209 use Pod::Text ();
  2         2  
  2         36  
24 2     2   644 use Term::ANSIColor qw(colored);
  2         4901  
  2         625  
25              
26 2     2   8 use vars qw(@ISA $VERSION);
  2         3  
  2         748  
27              
28             @ISA = qw(Pod::Text);
29              
30             $VERSION = '4.08';
31              
32             ##############################################################################
33             # Overrides
34             ##############################################################################
35              
36             # Make level one headings bold.
37             sub cmd_head1 {
38 11     11 0 13 my ($self, $attrs, $text) = @_;
39 11         22 $text =~ s/\s+$//;
40 11         23 $self->SUPER::cmd_head1 ($attrs, colored ($text, 'bold'));
41             }
42              
43             # Make level two headings bold.
44             sub cmd_head2 {
45 2     2 0 3 my ($self, $attrs, $text) = @_;
46 2         6 $text =~ s/\s+$//;
47 2         5 $self->SUPER::cmd_head2 ($attrs, colored ($text, 'bold'));
48             }
49              
50             # Fix the various formatting codes.
51 12     12 0 22 sub cmd_b { return colored ($_[2], 'bold') }
52 3     3 0 6 sub cmd_f { return colored ($_[2], 'cyan') }
53 16     16 0 34 sub cmd_i { return colored ($_[2], 'yellow') }
54              
55             # Output any included code in green.
56             sub output_code {
57 0     0 0 0 my ($self, $code) = @_;
58 0         0 $code = colored ($code, 'green');
59 0         0 $self->output ($code);
60             }
61              
62             # Strip all of the formatting from a provided string, returning the stripped
63             # version. We will eventually want to use colorstrip() from Term::ANSIColor,
64             # but it's fairly new so avoid the tight dependency.
65             sub strip_format {
66 29     29 0 26 my ($self, $text) = @_;
67 29         31 $text =~ s/\e\[[\d;]*m//g;
68 29         44 return $text;
69             }
70              
71             # We unfortunately have to override the wrapping code here, since the normal
72             # wrapping code gets really confused by all the escape sequences.
73             sub wrap {
74 101     101 0 88 my $self = shift;
75 101         79 local $_ = shift;
76 101         75 my $output = '';
77 101         107 my $spaces = ' ' x $$self{MARGIN};
78 101         97 my $width = $$self{opt_width} - $$self{MARGIN};
79              
80             # We have to do $shortchar and $longchar in variables because the
81             # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x.
82 101         67 my $char = '(?:(?:\e\[[\d;]+m)*[^\n])';
83 101         115 my $shortchar = $char . "{0,$width}";
84 101         94 my $longchar = $char . "{$width}";
85 101         175 while (length > $width) {
86 32 50 33     723 if (s/^($shortchar)\s+// || s/^($longchar)//) {
87 32         105 $output .= $spaces . $1 . "\n";
88             } else {
89 0         0 last;
90             }
91             }
92 101         123 $output .= $spaces . $_;
93 101         325 $output =~ s/\s+$/\n\n/;
94 101         263 $output;
95             }
96              
97             ##############################################################################
98             # Module return value and documentation
99             ##############################################################################
100              
101             1;
102             __END__