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   31136 use Term::ANSIColor qw(colorstrip uncolor);
  6         51291  
  6         4024  
5 6     6   3464 use common::sense;
  6         73  
  6         29  
6 6     6   377 use base 'Exporter';
  6         11  
  6         5570  
7              
8             our $VERSION = '2.7193';
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 619 my $color = shift;
60 36         75 my $no_nick = $color =~ s/\a//g;
61              
62 36         92 $color =~ s/[^\w]/ /g;
63 36         72 $color =~ s/on (\w+)/on_$1/g;
64 36         51 $color =~ s/un bold/unbold/g;
65 36         62 $color =~ s/([mn]c) (dir|file|exec?|curs|[pc]wd)/$1_$2/g;
66              
67             my @cl = map {
68 36         86 (!$no_nick && exists $NICKNAMES{$_})
69 64 100 100     277 ? split(" ", $NICKNAMES{$_}) : $_
70             } split(" ", $color);
71              
72             FIXCL: {
73 36         60 my %m = (faint=>1, dark=>1, bold=>1, bright=>1, clear=>1);
  43         146  
74 43         105 for my $i (0 .. $#cl) {
75 70 100       164 if( $m{$cl[$i]} ) {
76 25         38 my $l = 1;
77              
78 25         71 $l ++ while $m{$cl[ $i+$l ]};
79              
80 25 100       57 if( $l > 1 ) {
81 7         17 splice @cl, $i, $l, $cl[$i];
82 7         21 redo FIXCL;
83             }
84             }
85             }
86             }
87              
88 36 100       91 $color = join " ", @cl>1 ? grep {$_ ne "clear"} @cl : @cl;
  48         102  
89              
90 36         97 return $color;
91             }
92              
93             sub color(_) {
94 23     23 1 2517 @_ = (fix_color $_[0]);
95 23         70 goto &Term::ANSIColor::color;
96             }
97              
98             sub colorvalid(_) {
99 6     6 1 482 @_ = (fix_color $_[0]);
100 6         17 goto &Term::ANSIColor::colorvalid;
101             }
102              
103             sub colored {
104 3     3 1 823 my ($string, @codes);
105              
106 3 100       9 if (ref $_[0]) {
107 1         2 @codes = @{+shift};
  1         3  
108 1         4 $string = join ('', @_);
109              
110             } else {
111 2         4 $string = shift;
112 2         5 @codes = @_;
113             }
114              
115 3         14 @_ = ($string, map {fix_color} @codes);
  3         7  
116 3         11 goto &Term::ANSIColor::colored;
117             }
118              
119             "true";
120              
121             __END__