File Coverage

blib/lib/Getopt/EX/Colormap.pm

Criterion	Covered	Total	%
statement	51	83	61.4
branch	3	18	16.6
condition	1	10	10.0
subroutine	15	19	78.9
pod	4	4	100.0
total	74	134	55.2

package Getopt::EX::Colormap;
use version; our $VERSION = version->declare("2.1.4");

use v5.14;
use utf8;

use Exporter 'import';
our @EXPORT_OK = (
    qw( colorize colorize24 ansi_code ansi_pair csi_code ),
    qw( colortable colortable6 colortable12 colortable24 ),
    );
our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );

use Carp;
use Data::Dumper;
$Data::Dumper::Sortkeys = 1;

use List::Util qw(min max first);

use parent 'Getopt::EX::LabeledParam';
use Getopt::EX::Util;
use Getopt::EX::Func qw(callable);

use Term::ANSIColor::Concise qw(:all);
{
    no strict 'refs';
    *colorize   = \&ansi_color;
    *colorize24 = \&ansi_color_24;
    for my $name (
	qw( NO_NO_COLOR
	    NO_COLOR
	    RGB24
	    LINEAR_256
	    LINEAR_GRAY
	    NO_RESET_EL
	    SPLIT_ANSI
	)) {
	*{$name} = *{"Term::ANSIColor::Concise::$name"};
    }
}

#use Term::ANSIColor::Concise::Table qw(:all);
sub AUTOLOAD {
    my $sub = our $AUTOLOAD =~ s/.*:://r;
    return if $sub eq 'DESTROY';
    if ($sub =~ /^colortable(?:|6|12|24)$/) {
	require Term::ANSIColor::Concise::Table
	    and Term::ANSIColor::Concise::Table->import(':all');
	goto &$sub;
    }
    die "Invalid call for $sub().\n";
}

our $NO_NO_COLOR //= $ENV{GETOPTEX_NO_NO_COLOR};
our $NO_COLOR    //= !$NO_NO_COLOR && defined $ENV{NO_COLOR};
our $RGB24       //= $ENV{COLORTERM}//'' eq 'truecolor' || $ENV{GETOPTEX_RGB24};
our $LINEAR_256  //= $ENV{GETOPTEX_LINEAR_256};
our $LINEAR_GRAY //= $ENV{GETOPTEX_LINEAR_GRAY};
our $NO_RESET_EL //= $ENV{GETOPTEX_NO_RESET_EL};
our $SPLIT_ANSI  //= $ENV{GETOPTEX_SPLIT_ANSI};

sub new {
    my $class = shift;
    my $obj = $class->SUPER::new;
    my %opt = @_;

    $obj->{CACHE} = {};
    $opt{CONCAT} //= "^"; # Reset character for LabeledParam object
    $obj->configure(%opt);

    $obj;
}

sub index_color {
    my $obj = shift;
    my $index = shift;
    my $text = shift;

    my $list = $obj->{LIST};
    if (@$list) {
	$text = $obj->color($list->[$index % @$list], $text, $index);
    }
    $text;
}

sub color {
    my $obj = shift;
    my $color = shift;
    my $text = shift;

    my $map = $obj->{HASH};
    my $c = exists $map->{$color} ? $map->{$color} : $color;

    return $text unless $c;

    cached_ansi_color($obj->{CACHE}, $c, $text);
}

sub colormap {
    my $obj = shift;
    my %opt = @_;
    $opt{name}    //= "--newopt";
    $opt{option}  //= "--colormap";
    $opt{sort}    //= "length";

    my $hash = $obj->{HASH};
    join "\n", (
	"option $opt{name} \\",
	do {
	    my $maxlen = $opt{noalign} ? "" : do {
		max map { length } keys %{$hash};
	    };
	    my $format = "\t%s %${maxlen}s=%s \\";
	    my $compare = do {
		if ($opt{sort} eq "length") {
		    sub { length $a <=> length $b or $a cmp $b };
		} else {
		    sub { $a cmp $b };
		}
	    };
	    map {
		sprintf $format, $opt{option}, $_, $hash->{$_} // "";
	    } sort $compare keys %{$hash};
	},
	"\t\$\n",
	);
}

1;

__END__