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


line stmt bran cond sub pod time code
1              
2             package Term::ANSIColorx::ColorNicknames;
3              
4 6     6   23558 use Term::ANSIColor qw(colorstrip uncolor);
  6         32833  
  6         1879  
5 6     6   2858 use common::sense;
  6         38  
  6         17  
6 6     6   263 use base 'Exporter';
  6         9  
  6         3994  
7              
8             our $VERSION = '2.7191_2';
9              
10             our @FIXED = qw(color colorvalid colored);
11             our @EXPORT_OK = qw(fix_color color colorvalid colored colorstrip uncolor);
12             our %EXPORT_TAGS = ( all => \@EXPORT_OK, fixed=>\@FIXED );
13              
14             our %NICKNAMES = (
15             normal => "clear",
16             unbold => "clear",
17              
18             blood => "red",
19             umber => "bold red",
20             sky => "bold blue",
21             ocean => "cyan",
22             lightblue => "cyan",
23             cyan => "bold cyan",
24             lime => "bold green",
25             orange => "yellow",
26             brown => "yellow",
27             yellow => "bold yellow",
28             purple => "magenta",
29             violet => "bold magenta",
30             pink => "bold magenta",
31             pitch => "bold black",
32             coal => "bold black",
33             grey => "white",
34             gray => "white",
35             white => "bold white",
36              
37             dire => "bold yellow on_red",
38             alert => "bold yellow on_red",
39             todo => "black on_yellow",
40              
41             nc_dir => "bold white on_blue",
42             nc_file => "bold white on_blue",
43             nc_exe => "bold green on_blue",
44             nc_exec => "bold green on_blue",
45             nc_curs => "black on_cyan",
46             nc_pwd => "black on_white",
47             nc_cwd => "black on_white",
48              
49             mc_dir => "bold white on_blue",
50             mc_file => "bold white on_blue",
51             mc_exe => "bold green on_blue",
52             mc_exec => "bold green on_blue",
53             mc_curs => "black on_cyan",
54             mc_pwd => "black on_white",
55             mc_cwd => "black on_white",
56             );
57              
58             sub fix_color(_) {
59 36     36 1 419 my $color = shift;
60 36         46 my $no_nick = $color =~ s/\a//g;
61              
62 36         67 $color =~ s/[^\w]/ /g;
63 36         46 $color =~ s/on (\w+)/on_$1/g;
64 36         30 $color =~ s/un bold/unbold/g;
65 36         37 $color =~ s/([mn]c) (dir|file|exec?|curs|[pc]wd)/$1_$2/g;
66              
67 64 100 100     250 my @cl = map {
68 36         55 (!$no_nick && exists $NICKNAMES{$_})
69             ? split(" ", $NICKNAMES{$_}) : $_
70             } split(" ", $color);
71              
72 43         97 FIXCL: {
73 36         35 my %m = (faint=>1, dark=>1, bold=>1, bright=>1, clear=>1);
74 43         60 for my $i (0 .. $#cl) {
75 70 100       137 if( $m{$cl[$i]} ) {
76 25         20 my $l = 1;
77              
78 25         57 $l ++ while $m{$cl[ $i+$l ]};
79              
80 25 100       63 if( $l > 1 ) {
81 7         11 splice @cl, $i, $l, $cl[$i];
82 7         16 redo FIXCL;
83             }
84             }
85             }
86             }
87              
88 36 100       68 $color = join " ", @cl>1 ? grep {$_ ne "clear"} @cl : @cl;
  48         59  
89              
90 36         73 return $color;
91             }
92              
93             sub color(_) {
94 23     23 1 3630 @_ = (fix_color $_[0]);
95 23         56 goto &Term::ANSIColor::color;
96             }
97              
98             sub colorvalid(_) {
99 6     6 1 339 @_ = (fix_color $_[0]);
100 6         15 goto &Term::ANSIColor::colorvalid;
101             }
102              
103             sub colored {
104 3     3 1 523 my ($string, @codes);
105              
106 3 100       7 if (ref $_[0]) {
107 1         2 @codes = @{+shift};
  1         2  
108 1         7 $string = join ('', @_);
109              
110             } else {
111 2         3 $string = shift;
112 2         2 @codes = @_;
113             }
114              
115 3         2 @_ = ($string, map {fix_color} @codes);
  3         5  
116 3         8 goto &Term::ANSIColor::colored;
117             }
118              
119             "true";
120              
121             __END__