File Coverage

blib/lib/Term/ExtendedColor.pm
Criterion Covered Total %
statement 93 93 100.0
branch 49 60 81.6
condition 7 9 77.7
subroutine 19 19 100.0
pod 10 10 100.0
total 178 191 93.1


line stmt bran cond sub pod time code
1             package Term::ExtendedColor;
2 4     4   220839 use strict;
  4         31  
  4         99  
3 4     4   17 use warnings;
  4         8  
  4         95  
4 4     4   18 use Carp;
  4         7  
  4         266  
5              
6             BEGIN {
7 4     4   25 use Exporter;
  4         6  
  4         145  
8 4     4   20 use vars qw($VERSION @ISA @EXPORT_OK %EXPORT_TAGS);
  4         7  
  4         470  
9              
10 4     4   12 $VERSION = '0.504';
11 4         59 @ISA = qw(Exporter);
12              
13 4         19 @EXPORT_OK = qw(
14             uncolor
15             uncolour
16             get_colors
17             get_colours
18             autoreset
19             fg
20             bg
21             clear
22             bold
23             italic
24             underline
25             inverse
26             );
27              
28 4         121 %EXPORT_TAGS = (
29             attributes => [ qw(fg bg clear bold italic underline inverse) ],
30             all => [ @EXPORT_OK ],
31             );
32             }
33              
34             {
35 4     4   20 no warnings 'once';
  4         6  
  4         4798  
36             *uncolour = *Term::ExtendedColor::uncolor;
37             *get_colours = *Term::ExtendedColor::get_colors;
38             }
39              
40             our $AUTORESET = 1;
41              
42             my %attributes = (
43             reset => 0,
44             clear => 0,
45             normal => 0,
46             bold => 1,
47             bright => 1,
48             faint => 2,
49             italic => 3,
50             cursive => 3,
51             underline => 4,
52             underscore => 4,
53             blink => 5,
54             blink_ms => 6,
55             reverse => 7,
56             inverse => 7,
57             negative => 7,
58             conceal => 8,
59             );
60              
61             my %color_names = (
62              
63             reset => 0, clear => 0, normal => 0,
64             bold => 1, bright => 1,
65             faint => 2,
66             italic => 3, cursive => 3,
67             underline => 4, underscore => 4,
68              
69             # Blink: slow
70             blink => 5,
71              
72             # Blink: rapid (MS DOS ANSI.SYS, not widely supported)
73             blink_ms => 6,
74              
75             reverse => 7, inverse => 7, negative => 7,
76             conceal => 8,
77              
78             # Brightest to darkest color
79              
80             red1 => '5;196',
81             red2 => '5;160',
82             red3 => '5;124',
83             red4 => '5;088',
84             red5 => '5;052',
85              
86             green1 => '5;156',
87             green2 => '5;150',
88             green3 => '5;120',
89             green4 => '5;114',
90             green5 => '5;084',
91             green6 => '5;078',
92             green7 => '5;155',
93             green8 => '5;149',
94             green9 => '5;119',
95             green10 => '5;113',
96             green11 => '5;083',
97             green12 => '5;077',
98             green13 => '5;047',
99             green14 => '5;041',
100             green15 => '5;118',
101             green16 => '5;112',
102             green17 => '5;082',
103             green18 => '5;076',
104             green19 => '5;046',
105             green20 => '5;040',
106             green21 => '5;034',
107             green22 => '5;028',
108             green23 => '5;022',
109             green24 => '5;107',
110             green25 => '5;071',
111             green26 => '5;070',
112             green27 => '5;064',
113             green28 => '5;065',
114              
115             blue1 => '5;075',
116             blue2 => '5;074',
117             blue3 => '5;073',
118             blue4 => '5;039',
119             blue5 => '5;038',
120             blue6 => '5;037',
121             blue7 => '5;033',
122             blue8 => '5;032',
123             blue9 => '5;031',
124             blue10 => '5;027',
125             blue11 => '5;026',
126             blue12 => '5;025',
127             blue13 => '5;021',
128             blue14 => '5;020',
129             blue15 => '5;019',
130             blue16 => '5;018',
131             blue17 => '5;017',
132              
133             yellow1 => '5;228',
134             yellow2 => '5;222',
135             yellow3 => '5;192',
136             yellow4 => '5;186',
137             yellow5 => '5;227',
138             yellow6 => '5;221',
139             yellow7 => '5;191',
140             yellow8 => '5;185',
141             yellow9 => '5;226',
142             yellow10 => '5;220',
143             yellow11 => '5;190',
144             yellow12 => '5;184',
145             yellow13 => '5;214',
146             yellow14 => '5;178',
147             yellow15 => '5;208',
148             yellow16 => '5;172',
149             yellow17 => '5;202',
150             yellow18 => '5;166',
151              
152             magenta1 => '5;219',
153             magenta2 => '5;183',
154             magenta3 => '5;218',
155             magenta4 => '5;182',
156             magenta5 => '5;217',
157             magenta6 => '5;181',
158             magenta7 => '5;213',
159             magenta8 => '5;177',
160             magenta9 => '5;212',
161             magenta10 => '5;176',
162             magenta11 => '5;211',
163             magenta12 => '5;175',
164             magenta13 => '5;207',
165             magenta14 => '5;171',
166             magenta15 => '5;206',
167             magenta16 => '5;170',
168             magenta15 => '5;205',
169             magenta16 => '5;169',
170             magenta17 => '5;201',
171             magenta18 => '5;165',
172             magenta19 => '5;200',
173             magenta20 => '5;164',
174             magenta21 => '5;199',
175             magenta22 => '5;163',
176             magenta23 => '5;198',
177             magenta24 => '5;162',
178             magenta25 => '5;197',
179             magenta26 => '5;161',
180              
181             gray1 => '5;255',
182             gray2 => '5;254',
183             gray3 => '5;253',
184             gray4 => '5;252',
185             gray5 => '5;251',
186             gray6 => '5;250',
187             gray7 => '5;249',
188             gray8 => '5;248',
189             gray9 => '5;247',
190             gray10 => '5;246',
191             gray11 => '5;245',
192             gray12 => '5;244',
193             gray13 => '5;243',
194             gray14 => '5;242',
195             gray15 => '5;241',
196             gray16 => '5;240',
197             gray17 => '5;239',
198             gray18 => '5;238',
199             gray19 => '5;237',
200             gray20 => '5;236',
201             gray21 => '5;235',
202             gray22 => '5;234',
203             gray23 => '5;233',
204             gray24 => '5;232',
205              
206             purple1 => '5;147',
207             purple2 => '5;146',
208             purple3 => '5;145',
209             purple4 => '5;141',
210             purple5 => '5;140',
211             purple6 => '5;139',
212             purple7 => '5;135',
213             purple8 => '5;134',
214             purple9 => '5;133',
215             purple10 => '5;129',
216             purple11 => '5;128',
217             purple12 => '5;127',
218             purple13 => '5;126',
219             purple14 => '5;125',
220             purple15 => '5;111',
221             purple16 => '5;110',
222             purple17 => '5;109',
223             purple18 => '5;105',
224             purple19 => '5;104',
225             purple20 => '5;103',
226             purple21 => '5;099',
227             purple22 => '5;098',
228             purple23 => '5;097',
229             purple24 => '5;096',
230             purple25 => '5;093',
231             purple26 => '5;092',
232             purple27 => '5;091',
233             purple28 => '5;090',
234              
235             purple29 => '5;055',
236             purple30 => '5;054',
237              
238             cyan1 => '5;159',
239             cyan2 => '5;158',
240             cyan3 => '5;157',
241             cyan4 => '5;153',
242             cyan5 => '5;152',
243             cyan6 => '5;151',
244             cyan7 => '5;123',
245             cyan8 => '5;122',
246             cyan9 => '5;121',
247             cyan10 => '5;117',
248             cyan11 => '5;116',
249             cyan12 => '5;115',
250             cyan13 => '5;087',
251             cyan14 => '5;086',
252             cyan15 => '5;085',
253             cyan16 => '5;081',
254             cyan17 => '5;080',
255             cyan18 => '5;079',
256             cyan19 => '5;051',
257             cyan20 => '5;050',
258             cyan21 => '5;049',
259             cyan22 => '5;045',
260             cyan23 => '5;044',
261             cyan24 => '5;043',
262              
263             orange1 => '5;208',
264             orange2 => '5;172',
265             orange3 => '5;202',
266             orange4 => '5;166',
267             orange5 => '5;130',
268              
269             # Approximations of X11 color mappings
270             # https://secure.wikimedia.org/wikipedia/en/wiki/X11%20colors
271              
272             aquamarine1 => '5;086',
273             aquamarine3 => '5;079',
274             blueviolet => '5;057',
275             cadetblue1 => '5;072',
276             cadetblue2 => '5;073',
277             chartreuse1 => '5;118',
278             chartreuse2 => '5;082',
279             chartreuse3 => '5;070',
280             chartreuse4 => '5;064',
281             cornflowerblue => '5;069',
282             cornsilk1 => '5;230',
283             darkblue => '5;018',
284             darkcyan => '5;036',
285             darkgoldenrod => '5;136',
286             darkgreen => '5;022',
287             darkkhaki => '5;143',
288             darkmagenta1 => '5;090',
289             darkmagenta2 => '5;091',
290             darkolivegreen1 => '5;191',
291             darkolivegreen2 => '5;155',
292             darkolivegreen3 => '5;107',
293             darkolivegreen4 => '5;113',
294             darkolivegreen5 => '5;149',
295             darkorange3 => '5;130',
296             darkorange4 => '5;166',
297             darkorange1 => '5;208',
298             darkred1 => '5;052',
299             darkred2 => '5;088',
300             darkseagreen1 => '5;158',
301             darkseagreen2 => '5;157',
302             darkseagreen3 => '5;150',
303             darkseagreen4 => '5;071',
304             darkslategray1 => '5;123',
305             darkslategray2 => '5;087',
306             darkslategray3 => '5;116',
307             darkturquoise => '5;044',
308             darkviolet => '5;128',
309             deeppink1 => '5;198',
310             deeppink2 => '5;197',
311             deeppink3 => '5;162',
312             deeppink4 => '5;125',
313             deepskyblue1 => '5;039',
314             deepskyblue2 => '5;038',
315             deepskyblue3 => '5;031',
316             deepskyblue4 => '5;023',
317             deepskyblue4 => '5;025',
318             dodgerblue1 => '5;033',
319             dodgerblue2 => '5;027',
320             dodgerblue3 => '5;026',
321             gold1 => '5;220',
322             gold3 => '5;142',
323             greenyellow => '5;154',
324             grey0 => '5;016',
325             grey100 => '5;231',
326             grey11 => '5;234',
327             grey15 => '5;235',
328             grey19 => '5;236',
329             grey23 => '5;237',
330             grey27 => '5;238',
331             grey30 => '5;239',
332             grey3 => '5;232',
333             grey35 => '5;240',
334             grey37 => '5;059',
335             grey39 => '5;241',
336             grey42 => '5;242',
337             grey46 => '5;243',
338             grey50 => '5;244',
339             grey53 => '5;102',
340             grey54 => '5;245',
341             grey58 => '5;246',
342             grey62 => '5;247',
343             grey63 => '5;139',
344             grey66 => '5;248',
345             grey69 => '5;145',
346             grey70 => '5;249',
347             grey74 => '5;250',
348             grey7 => '5;233',
349             grey78 => '5;251',
350             grey82 => '5;252',
351             grey84 => '5;188',
352             grey85 => '5;253',
353             grey89 => '5;254',
354             grey93 => '5;255',
355             honeydew2 => '5;194',
356             hotpink2 => '5;169',
357             hotpink3 => '5;132',
358             hotpink => '5;205',
359             indianred1 => '5;203',
360             indianred => '5;167',
361             khaki1 => '5;228',
362             khaki3 => '5;185',
363             lightcoral => '5;210',
364             lightcyan1 => '5;195',
365             lightcyan3 => '5;152',
366             lightgoldenrod1 => '5;227',
367             lightgoldenrod2 => '5;186',
368             lightgoldenrod3 => '5;179',
369             lightgreen => '5;119',
370             lightpink1 => '5;217',
371             lightpink3 => '5;174',
372             lightpink4 => '5;095',
373             lightsalmon1 => '5;216',
374             lightsalmon3 => '5;137',
375             lightsalmon3 => '5;173',
376             lightseagreen => '5;037',
377             lightskyblue1 => '5;153',
378             lightskyblue3 => '5;109',
379             lightskyblue3 => '5;110',
380             lightslateblue => '5;105',
381             lightslategrey => '5;103',
382             lightsteelblue1 => '5;189',
383             lightsteelblue3 => '5;146',
384             lightsteelblue => '5;147',
385             lightyellow3 => '5;187',
386             mediumorchid1 => '5;171',
387             mediumorchid3 => '5;133',
388             mediumorchid => '5;134',
389             mediumpurple1 => '5;141',
390             mediumpurple2 => '5;135',
391             mediumpurple3 => '5;097',
392             mediumpurple4 => '5;060',
393             mediumpurple => '5;104',
394             mediumspringgreen => '5;049',
395             mediumturquoise => '5;080',
396             mediumvioletred => '5;126',
397             mistyrose1 => '5;224',
398             mistyrose3 => '5;181',
399             navajowhite1 => '5;223',
400             navajowhite3 => '5;144',
401             navyblue => '5;017',
402             orangered1 => '5;202',
403             orchid1 => '5;213',
404             orchid2 => '5;212',
405             orchid => '5;170',
406             palegreen1 => '5;121',
407             palegreen3 => '5;077',
408             paleturquoise1 => '5;159',
409             paleturquoise4 => '5;066',
410             palevioletred1 => '5;211',
411             pink1 => '5;218',
412             pink3 => '5;175',
413             plum1 => '5;219',
414             plum2 => '5;183',
415             plum3 => '5;176',
416             plum4 => '5;096',
417             purple => '5;129',
418             rosybrown => '5;138',
419             royalblue1 => '5;063',
420             salmon1 => '5;209',
421             sandybrown => '5;215',
422             seagreen1 => '5;084',
423             seagreen2 => '5;083',
424             seagreen3 => '5;078',
425             skyblue1 => '5;117',
426             skyblue2 => '5;111',
427             skyblue3 => '5;074',
428             slateblue1 => '5;099',
429             slateblue3 => '5;061',
430             springgreen1 => '5;048',
431             springgreen2 => '5;042',
432             springgreen3 => '5;035',
433             springgreen4 => '5;029',
434             steelblue1 => '5;075',
435             steelblue3 => '5;068',
436             steelblue => '5;067',
437             tan => '5;180',
438             thistle1 => '5;225',
439             thistle3 => '5;182',
440             turquoise2 => '5;045',
441             turquoise4 => '5;030',
442             violet => '5;177',
443             wheat1 => '5;229',
444             wheat4 => '5;101',
445             );
446              
447             our($fg_called, $bg_called);
448              
449             my ($fg, $bg) = ("\e[38;", "\e[48;");
450             my($start, $end);
451              
452              
453             =begin comment
454              
455             as of Term::ExtendedColor > 0.302:
456              
457             call to fg and bg with zero args resets only the relevant color to a
458             default value. In earlier versions, the string
459              
460             \e[m
461              
462             was returned which resets _all_ attributes.
463              
464             =end comment
465             =cut
466              
467             sub fg {
468 13 100   13 1 3410 return "\e[39m" if not defined $_[0];
469              
470 12         16 $fg_called = 1;
471 12         21 _color(@_);
472             }
473              
474             sub bg {
475 6 100   6 1 2522 return "\e[49m" if not defined $_[0];
476              
477 5         8 $bg_called = 1;
478 5         10 _color(@_);
479             }
480              
481              
482              
483             =begin comment
484              
485             as of Term::ExtendedColor > 0.302:
486             bold(), italic(), underline() and inverse() each has the ability to act as a
487             switch where only a given attribute is switched off.
488              
489             \e[22;23;24;25;27;28;29m
490              
491             not {bold, italic, underlined, blinking, inverse, hidden}
492              
493             is the same thing as
494              
495             \e[m
496              
497             clear() still resets all attributes.
498              
499             =end comment
500             =cut
501              
502             sub bold {
503 1 50   1 1 69 return "\e[22m" if not defined $_[0];
504              
505 1         2 $fg_called = 1;
506 1         16 _color('bold', @_);
507             }
508              
509             sub italic {
510 1 50   1 1 4 return "\e[23m" if not defined $_[0];
511              
512 1         2 $fg_called = 1;
513 1         3 _color('italic', @_);
514             }
515              
516             sub underline {
517 1 50   1 1 3 return "\e[24m" if not defined $_[0];
518              
519 1         3 $fg_called = 1;
520 1         3 _color('underline', @_);
521             }
522              
523             sub inverse {
524 1 50   1 1 3 return "\e27m" if not defined $_[0];
525              
526 1         3 $fg_called = 1;
527 1         3 _color('inverse', @_);
528             }
529              
530             sub clear {
531 1 50   1 1 434 defined(wantarray()) ? return "\e[m" : print "\e[m";
532             }
533              
534 2     2 1 79 sub get_colors { return \%color_names; }
535              
536              
537             sub _color {
538 21     21   40 my($color_str, $data) = @_;
539              
540 21 50       35 croak "no color str provided to Term::ExtendedColor" if ! defined $color_str;
541              
542 21         24 my $access_by_numeric_index = 0;
543 21         67 my $access_by_raw_attr = 0;
544              
545             =begin comment
546              
547              
548             A normal escape sequence looks like
549              
550             \e[38;5;220;1m
551              
552             But that's only because the implementation is broken. It *should* instead be
553              
554             \e[38:5:220:1m
555              
556             We better support both.
557              
558             Here we support somewhat arbitary groups of colors/attributes, for
559             complex cases, i.e:
560              
561             38;5;197;48;5;53;1;3;4;5;7
562              
563             You'll rarely need this, but if you do, there's support for it.
564              
565             We also need to support possible variations of standard ANSI codes, i.e:
566              
567              
568             01;03;35
569             35;1;3
570              
571             =end comment
572             =cut
573              
574              
575 21 100       85 if($color_str =~ m/^(?:\x1b\[)?([0-9;:]+m?)/) {
576 4 50       18 $access_by_raw_attr = $1 =~ m/m$/ ? $1 : "$1m";
577             }
578              
579              
580             # No key found in the table, and not using a valid number.
581             # Return data if any, else the invalid color string.
582 21 100 100     73 if( (! exists($color_names{$color_str})) and ($color_str !~ /^[0-9]+$/m) ) {
583 7 100       23 return ($data) ? $data : $color_str unless $access_by_raw_attr;
    100          
584             }
585              
586             # Foreground or background?
587 17 100       35 ($start) = ($fg_called) ? "\e[38;" : "\e[48;";
588 17 100       25 ($end) = ($AUTORESET) ? "\e[m" : '';
589              
590             # this is because we need to handle attributes differently thanks to
591             # broken implementation at various places
592 17 100       34 ($start) = exists($attributes{$color_str}) ? "\e[" : $start;
593              
594             =begin comment
595              
596             This is messy. According to spec...
597              
598             38;1
599              
600             should yield bold, and it does in urxvt and vte, but not in xterm.
601              
602             38;1;3;4;5;7
603              
604             should yield bold + italic + underline + blink + reverse
605              
606             which it does in urxvt and vte, but in xterm it yields italic +
607             underline + blink + reverse
608              
609             ON THE OTHER HAND
610              
611             38:5;1
612             38:5;1;2;3;4;5;6
613              
614             yields attributes correctly in xterm, urxvt and vte.
615              
616             HOWEVER
617              
618             38;5;220
619              
620             yields yellow text, and
621              
622             38;5;220;5
623              
624             yields yellow, blinking text, but
625              
626             38:5;220;5
627              
628             yields blinking non-colored text.
629              
630             Ergo, no safe way of adding color and attributes in the same sequence,
631             so if we want to add bold, italic, underline and color index 220 to
632             input, we would have to do
633              
634             38:5;1;3;7;38;5;220
635              
636              
637             =end comment
638              
639             =cut
640              
641              
642             # Allow access to not defined color values: fg(221);
643 17 50 66     51 if( ($color_str =~ /^\d+$/m) and ($color_str < 256) and ($color_str > -1) ) {
      66        
644 1         4 $color_str = $start . "5;$color_str" . 'm';
645 1         2 $access_by_numeric_index = 1;
646             }
647              
648             # Called with no data. The only useful operation here is to return the
649             # attribute code with no end sequence. Basicly the same thing as if
650             # $AUTORESET == 0.
651 17 100       31 if(!defined($data)) { # 0 is a valid argument
652 1 50       7 return ($access_by_numeric_index)
653             ? $color_str
654             : "$start$color_names{$color_str}m"
655             ;
656             }
657              
658             {
659             # This is for operations like fg('bold', fg('red1'));
660 4     4   68 no warnings; # For you, Test::More
  4         18  
  4         1660  
  16         17  
661 16 100       38 if($data =~ /;(\d+;\d+)m$/m) {
662 1         3 my $esc = $1;
663 1         92 my @escapes = values %color_names;
664 1         5 for(@escapes) {
665 300 100       384 if($esc eq $_) {
666 1         17 return $start . $color_names{$color_str} . 'm' . $data;
667             }
668             }
669             }
670              
671             } # end no warnings
672              
673 15         19 my @output;
674 15 100       30 if(ref($data) eq 'ARRAY') {
675 1         2 push(@output, @{$data});
  1         3  
676             }
677             else {
678 14         20 push(@output, $data);
679             }
680              
681 15         27 for my $line(@output) {
682 16 100       28 if($access_by_numeric_index) {
    100          
683 1         2 $line = $color_str . $line . $end;
684             }
685             elsif($access_by_raw_attr) {
686 3         7 $line = "\e[$access_by_raw_attr$line$end";
687             }
688             else {
689 12         32 $line = "$start$color_names{$color_str}m$line$end";
690             }
691             }
692              
693             # Restore state
694 15         19 ($fg_called, $bg_called) = (0, 0);
695              
696 15 100       70 return (wantarray()) ? (@output) : (join('', @output));
697             }
698              
699             sub uncolor {
700 5     5 1 1282 my @data = @_;
701 5 50       12 return if !@data;
702              
703 5 100       33 if(ref($data[0]) eq 'ARRAY') {
704 2         3 my $ref = shift @data;
705 2         4 push(@data, @{$ref});
  2         8  
706             }
707              
708 5         11 for(@data) {
709             # Test::More enables warnings..
710 61 50       90 if(defined($_)) {
711 61         176 $_ =~ s/\e\[[0-9;]*m//gm;
712             }
713             }
714 5 100       39 return (wantarray()) ? @data : join('', @data);
715             }
716              
717              
718             sub autoreset {
719 2     2 1 1338 $AUTORESET = shift;
720 2 100       6 ($end) = ($AUTORESET) ? "\e[m" : '';
721              
722 2         4 return;
723             }
724              
725              
726              
727             1;
728              
729             __END__