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


line stmt bran cond sub pod time code
1             package Getopt::EX::Colormap;
2 10     10   295967 use version; our $VERSION = version->declare("2.1.3");
  10         8239  
  10         65  
3              
4 10     10   993 use v5.14;
  10         46  
5 10     10   796 use utf8;
  10         31  
  10         73  
6              
7 10     10   292 use Exporter 'import';
  10         21  
  10         873  
8             our @EXPORT_OK = (
9             qw( colorize colorize24 ansi_code ansi_pair csi_code ),
10             qw( colortable colortable6 colortable12 colortable24 ),
11             );
12             our %EXPORT_TAGS = ( all => [ @EXPORT_OK ] );
13              
14 10     10   88 use Carp;
  10         20  
  10         732  
15 10     10   2810 use Data::Dumper;
  10         29083  
  10         847  
16             $Data::Dumper::Sortkeys = 1;
17              
18 10     10   69 use List::Util qw(min max first);
  10         33  
  10         981  
19              
20 10     10   4675 use parent 'Getopt::EX::LabeledParam';
  10         2836  
  10         61  
21 10     10   4690 use Getopt::EX::Util;
  10         25  
  10         453  
22 10     10   71 use Getopt::EX::Func qw(callable);
  10         21  
  10         430  
23              
24 10     10   6221 use Term::ANSIColor::Concise qw(:all);
  10         49667  
  10         1949  
25             {
26 10     10   77 no strict 'refs';
  10         90  
  10         8979  
27             *colorize = \&ansi_color;
28             *colorize24 = \&ansi_color_24;
29             for my $name (
30             qw( NO_NO_COLOR
31             NO_COLOR
32             RGB24
33             LINEAR_256
34             LINEAR_GRAY
35             NO_RESET_EL
36             SPLIT_ANSI
37             )) {
38             *{$name} = *{"Term::ANSIColor::Concise::$name"};
39             }
40             }
41              
42             #use Term::ANSIColor::Concise::Table qw(:all);
43             sub AUTOLOAD {
44 2     2   2181 my $sub = our $AUTOLOAD =~ s/.*:://r;
45 2 50       278 return if $sub eq 'DESTROY';
46 0 0       0 if ($sub =~ /^colortable(?:|6|12|24)$/) {
47             require Term::ANSIColor::Concise::Table
48 0 0       0 and Term::ANSIColor::Concise::Table->import(':all');
49 0         0 goto &$sub;
50             }
51 0         0 die "Invalid call for $sub().\n";
52             }
53              
54             our $NO_NO_COLOR //= $ENV{GETOPTEX_NO_NO_COLOR};
55             our $NO_COLOR //= !$NO_NO_COLOR && defined $ENV{NO_COLOR};
56             our $RGB24 //= $ENV{COLORTERM}//'' eq 'truecolor' || $ENV{GETOPTEX_RGB24};
57             our $LINEAR_256 //= $ENV{GETOPTEX_LINEAR_256};
58             our $LINEAR_GRAY //= $ENV{GETOPTEX_LINEAR_GRAY};
59             our $NO_RESET_EL //= $ENV{GETOPTEX_NO_RESET_EL};
60             our $SPLIT_ANSI //= $ENV{GETOPTEX_SPLIT_ANSI};
61              
62             sub new {
63 2     2 1 197 my $class = shift;
64 2         19 my $obj = $class->SUPER::new;
65 2         6 my %opt = @_;
66              
67 2         12 $obj->{CACHE} = {};
68 2   50     16 $opt{CONCAT} //= "^"; # Reset character for LabeledParam object
69 2         16 $obj->configure(%opt);
70              
71 2         7 $obj;
72             }
73              
74             sub index_color {
75 0     0 1 0 my $obj = shift;
76 0         0 my $index = shift;
77 0         0 my $text = shift;
78              
79 0         0 my $list = $obj->{LIST};
80 0 0       0 if (@$list) {
81 0         0 $text = $obj->color($list->[$index % @$list], $text, $index);
82             }
83 0         0 $text;
84             }
85              
86             sub color {
87 5     5 1 34 my $obj = shift;
88 5         8 my $color = shift;
89 5         7 my $text = shift;
90              
91 5         9 my $map = $obj->{HASH};
92 5 50       12 my $c = exists $map->{$color} ? $map->{$color} : $color;
93              
94 5 50       12 return $text unless $c;
95              
96 5         17 cached_ansi_color($obj->{CACHE}, $c, $text);
97             }
98              
99             sub colormap {
100 0     0 1   my $obj = shift;
101 0           my %opt = @_;
102 0   0       $opt{name} //= "--newopt";
103 0   0       $opt{option} //= "--colormap";
104 0   0       $opt{sort} //= "length";
105              
106 0           my $hash = $obj->{HASH};
107             join "\n", (
108             "option $opt{name} \\",
109 0           do {
110 0 0         my $maxlen = $opt{noalign} ? "" : do {
111 0           max map { length } keys %{$hash};
  0            
  0            
112             };
113 0           my $format = "\t%s %${maxlen}s=%s \\";
114 0           my $compare = do {
115 0 0         if ($opt{sort} eq "length") {
116 0 0   0     sub { length $a <=> length $b or $a cmp $b };
  0            
117             } else {
118 0     0     sub { $a cmp $b };
  0            
119             }
120             };
121             map {
122 0   0       sprintf $format, $opt{option}, $_, $hash->{$_} // "";
123 0           } sort $compare keys %{$hash};
  0            
124             },
125             "\t\$\n",
126             );
127             }
128              
129             1;
130              
131             __END__