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

# Pod::Text::Color -- Convert POD data to formatted color ASCII text
#
# This is just a basic proof of concept.  It should later be modified to make
# better use of color, take options changing what colors are used for what
# text, and the like.
#
# Copyright 1999, 2001, 2004, 2006, 2008, 2009, 2014
#     Russ Allbery
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.

##############################################################################
# Modules and declarations
##############################################################################

package Pod::Text::Color;

use 5.006;
use strict;
use warnings;

use Pod::Text ();
use Term::ANSIColor qw(colored);

use vars qw(@ISA $VERSION);

@ISA = qw(Pod::Text);

$VERSION = '4.09';

##############################################################################
# Overrides
##############################################################################

# Make level one headings bold.
sub cmd_head1 {
    my ($self, $attrs, $text) = @_;
    $text =~ s/\s+$//;
    $self->SUPER::cmd_head1 ($attrs, colored ($text, 'bold'));
}

# Make level two headings bold.
sub cmd_head2 {
    my ($self, $attrs, $text) = @_;
    $text =~ s/\s+$//;
    $self->SUPER::cmd_head2 ($attrs, colored ($text, 'bold'));
}

# Fix the various formatting codes.
sub cmd_b { return colored ($_[2], 'bold')   }
sub cmd_f { return colored ($_[2], 'cyan')   }
sub cmd_i { return colored ($_[2], 'yellow') }

# Output any included code in green.
sub output_code {
    my ($self, $code) = @_;
    $code = colored ($code, 'green');
    $self->output ($code);
}

# Strip all of the formatting from a provided string, returning the stripped
# version.  We will eventually want to use colorstrip() from Term::ANSIColor,
# but it's fairly new so avoid the tight dependency.
sub strip_format {
    my ($self, $text) = @_;
    $text =~ s/\e\[[\d;]*m//g;
    return $text;
}

# We unfortunately have to override the wrapping code here, since the normal
# wrapping code gets really confused by all the escape sequences.
sub wrap {
    my $self = shift;
    local $_ = shift;
    my $output = '';
    my $spaces = ' ' x $$self{MARGIN};
    my $width = $$self{opt_width} - $$self{MARGIN};

    # We have to do $shortchar and $longchar in variables because the
    # construct ${char}{0,$width} didn't do the right thing until Perl 5.8.x.
    my $char = '(?:(?:\e\[[\d;]+m)*[^\n])';
    my $shortchar = $char . "{0,$width}";
    my $longchar = $char . "{$width}";
    while (length > $width) {
        if (s/^($shortchar)\s+// || s/^($longchar)//) {
            $output .= $spaces . $1 . "\n";
        } else {
            last;
        }
    }
    $output .= $spaces . $_;
    $output =~ s/\s+$/\n\n/;
    $output;
}

##############################################################################
# Module return value and documentation
##############################################################################

1;
__END__