File Coverage

blib/lib/Term/ANSIColorx/ColorNicknames.pm

Criterion	Covered	Total	%
statement	43	43	100.0
branch	10	10	100.0
condition	3	3	100.0
subroutine	7	7	100.0
pod	4	4	100.0
total	67	67	100.0

package Term::ANSIColorx::ColorNicknames;

use Term::ANSIColor qw(colorstrip uncolor);
use common::sense;
use base 'Exporter';

our $VERSION = '2.7191_1';

our @FIXED       = qw(color colorvalid colored);
our @EXPORT_OK   = qw(fix_color color colorvalid colored colorstrip uncolor);
our %EXPORT_TAGS = ( all => \@EXPORT_OK, fixed=>\@FIXED );

our %NICKNAMES = (
    normal    => "clear",
    unbold    => "clear",

    blood     => "red",
    umber     => "bold red",
    sky       => "bold blue",
    ocean     => "cyan",
    lightblue => "cyan",
    cyan      => "bold cyan",
    lime      => "bold green",
    orange    => "yellow",
    brown     => "yellow",
    yellow    => "bold yellow",
    purple    => "magenta",
    violet    => "bold magenta",
    pink      => "bold magenta",
    pitch     => "bold black",
    coal      => "bold black",
    grey      => "white",
    gray      => "white",
    white     => "bold white",

    dire      => "bold yellow on_red",
    alert     => "bold yellow on_red",
    todo      => "black on_yellow",

    nc_dir  => "bold white on_blue",
    nc_file => "bold white on_blue",
    nc_exe  => "bold green on_blue",
    nc_exec => "bold green on_blue",
    nc_curs => "black on_cyan",
    nc_pwd  => "black on_white",
    nc_cwd  => "black on_white",

    mc_dir  => "bold white on_blue",
    mc_file => "bold white on_blue",
    mc_exe  => "bold green on_blue",
    mc_exec => "bold green on_blue",
    mc_curs => "black on_cyan",
    mc_pwd  => "black on_white",
    mc_cwd  => "black on_white",
);

sub fix_color(_) {
    my $color = shift;
    my $no_nick = $color =~ s/\a//g;

    $color =~ s/[^\w]/ /g;
    $color =~ s/on (\w+)/on_$1/g;
    $color =~ s/un bold/unbold/g;
    $color =~ s/([mn]c) (dir|file|exec?|curs|[pc]wd)/$1_$2/g;

    my @cl = map {
        (!$no_nick && exists $NICKNAMES{$_})
        ? split(" ", $NICKNAMES{$_}) : $_
    } split(" ", $color);

    FIXCL: {
        my %m = (faint=>1, dark=>1, bold=>1, bright=>1, clear=>1);
        for my $i (0 .. $#cl) {
            if( $m{$cl[$i]} ) {
                my $l = 1;

                $l ++ while $m{$cl[ $i+$l ]};

                if( $l > 1 ) {
                    splice @cl, $i, $l, $cl[$i];
                    redo FIXCL;
                }
            }
        }
    }

    $color = join " ", @cl>1 ? grep {$_ ne "clear"} @cl : @cl;

    return $color;
}

sub color(_) {
    @_ = (fix_color $_[0]);
    goto &Term::ANSIColor::color;
}

sub colorvalid(_) {
    @_ = (fix_color $_[0]);
    goto &Term::ANSIColor::colorvalid;
}

sub colored {
    my ($string, @codes);

    if (ref $_[0]) {
        @codes = @{+shift};
        $string = join ('', @_);

    } else {
        $string = shift;
        @codes = @_;
    }

    @_ = ($string, map {fix_color} @codes);
    goto &Term::ANSIColor::colored;
}

"true";

__END__