Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | # Term::ANSIColor -- Color screen output using ANSI escape sequences. |
2 | # $Id: ANSIColor.pm,v 1.10 2005/08/21 18:31:58 eagle Exp $ | |
3 | # | |
4 | # Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005 | |
5 | # by Russ Allbery <rra@stanford.edu> and Zenin | |
6 | # | |
7 | # This program is free software; you may redistribute it and/or modify it | |
8 | # under the same terms as Perl itself. | |
9 | # | |
10 | # Ah, September, when the sysadmins turn colors and fall off the trees.... | |
11 | # -- Dave Van Domelen | |
12 | ||
13 | ############################################################################## | |
14 | # Modules and declarations | |
15 | ############################################################################## | |
16 | ||
17 | package Term::ANSIColor; | |
18 | require 5.001; | |
19 | ||
20 | use strict; | |
21 | use vars qw($AUTOLOAD $AUTORESET $EACHLINE @ISA @EXPORT @EXPORT_OK | |
22 | %EXPORT_TAGS $VERSION %attributes %attributes_r); | |
23 | ||
24 | use Exporter (); | |
25 | @ISA = qw(Exporter); | |
26 | @EXPORT = qw(color colored); | |
27 | @EXPORT_OK = qw(uncolor); | |
28 | %EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD DARK UNDERLINE UNDERSCORE | |
29 | BLINK REVERSE CONCEALED BLACK RED GREEN | |
30 | YELLOW BLUE MAGENTA CYAN WHITE ON_BLACK | |
31 | ON_RED ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA | |
32 | ON_CYAN ON_WHITE)]); | |
33 | Exporter::export_ok_tags ('constants'); | |
34 | ||
35 | # Don't use the CVS revision as the version, since this module is also in Perl | |
36 | # core and too many things could munge CVS magic revision strings. | |
37 | $VERSION = '1.10'; | |
38 | ||
39 | ############################################################################## | |
40 | # Internal data structures | |
41 | ############################################################################## | |
42 | ||
43 | %attributes = ('clear' => 0, | |
44 | 'reset' => 0, | |
45 | 'bold' => 1, | |
46 | 'dark' => 2, | |
47 | 'underline' => 4, | |
48 | 'underscore' => 4, | |
49 | 'blink' => 5, | |
50 | 'reverse' => 7, | |
51 | 'concealed' => 8, | |
52 | ||
53 | 'black' => 30, 'on_black' => 40, | |
54 | 'red' => 31, 'on_red' => 41, | |
55 | 'green' => 32, 'on_green' => 42, | |
56 | 'yellow' => 33, 'on_yellow' => 43, | |
57 | 'blue' => 34, 'on_blue' => 44, | |
58 | 'magenta' => 35, 'on_magenta' => 45, | |
59 | 'cyan' => 36, 'on_cyan' => 46, | |
60 | 'white' => 37, 'on_white' => 47); | |
61 | ||
62 | # Reverse lookup. Alphabetically first name for a sequence is preferred. | |
63 | for (reverse sort keys %attributes) { | |
64 | $attributes_r{$attributes{$_}} = $_; | |
65 | } | |
66 | ||
67 | ############################################################################## | |
68 | # Implementation (constant form) | |
69 | ############################################################################## | |
70 | ||
71 | # Time to have fun! We now want to define the constant subs, which are named | |
72 | # the same as the attributes above but in all caps. Each constant sub needs | |
73 | # to act differently depending on whether $AUTORESET is set. Without | |
74 | # autoreset: | |
75 | # | |
76 | # BLUE "text\n" ==> "\e[34mtext\n" | |
77 | # | |
78 | # If $AUTORESET is set, we should instead get: | |
79 | # | |
80 | # BLUE "text\n" ==> "\e[34mtext\n\e[0m" | |
81 | # | |
82 | # The sub also needs to handle the case where it has no arguments correctly. | |
83 | # Maintaining all of this as separate subs would be a major nightmare, as well | |
84 | # as duplicate the %attributes hash, so instead we define an AUTOLOAD sub to | |
85 | # define the constant subs on demand. To do that, we check the name of the | |
86 | # called sub against the list of attributes, and if it's an all-caps version | |
87 | # of one of them, we define the sub on the fly and then run it. | |
88 | # | |
89 | # If the environment variable ANSI_COLORS_DISABLED is set, turn all of the | |
90 | # generated subs into pass-through functions that don't add any escape | |
91 | # sequences. This is to make it easier to write scripts that also work on | |
92 | # systems without any ANSI support, like Windows consoles. | |
93 | sub AUTOLOAD { | |
94 | my $enable_colors = !defined $ENV{ANSI_COLORS_DISABLED}; | |
95 | my $sub; | |
96 | ($sub = $AUTOLOAD) =~ s/^.*:://; | |
97 | my $attr = $attributes{lc $sub}; | |
98 | if ($sub =~ /^[A-Z_]+$/ && defined $attr) { | |
99 | $attr = $enable_colors ? "\e[" . $attr . 'm' : ''; | |
100 | eval qq { | |
101 | sub $AUTOLOAD { | |
102 | if (\$AUTORESET && \@_) { | |
103 | '$attr' . "\@_" . "\e[0m"; | |
104 | } else { | |
105 | ('$attr' . "\@_"); | |
106 | } | |
107 | } | |
108 | }; | |
109 | goto &$AUTOLOAD; | |
110 | } else { | |
111 | require Carp; | |
112 | Carp::croak ("undefined subroutine &$AUTOLOAD called"); | |
113 | } | |
114 | } | |
115 | ||
116 | ############################################################################## | |
117 | # Implementation (attribute string form) | |
118 | ############################################################################## | |
119 | ||
120 | # Return the escape code for a given set of color attributes. | |
121 | sub color { | |
122 | return '' if defined $ENV{ANSI_COLORS_DISABLED}; | |
123 | my @codes = map { split } @_; | |
124 | my $attribute = ''; | |
125 | foreach (@codes) { | |
126 | $_ = lc $_; | |
127 | unless (defined $attributes{$_}) { | |
128 | require Carp; | |
129 | Carp::croak ("Invalid attribute name $_"); | |
130 | } | |
131 | $attribute .= $attributes{$_} . ';'; | |
132 | } | |
133 | chop $attribute; | |
134 | ($attribute ne '') ? "\e[${attribute}m" : undef; | |
135 | } | |
136 | ||
137 | # Return a list of named color attributes for a given set of escape codes. | |
138 | # Escape sequences can be given with or without enclosing "\e[" and "m". The | |
139 | # empty escape sequence '' or "\e[m" gives an empty list of attrs. | |
140 | sub uncolor { | |
141 | my (@nums, @result); | |
142 | for (@_) { | |
143 | my $escape = $_; | |
144 | $escape =~ s/^\e\[//; | |
145 | $escape =~ s/m$//; | |
146 | unless ($escape =~ /^((?:\d+;)*\d*)$/) { | |
147 | require Carp; | |
148 | Carp::croak ("Bad escape sequence $_"); | |
149 | } | |
150 | push (@nums, split (/;/, $1)); | |
151 | } | |
152 | for (@nums) { | |
153 | $_ += 0; # Strip leading zeroes | |
154 | my $name = $attributes_r{$_}; | |
155 | if (!defined $name) { | |
156 | require Carp; | |
157 | Carp::croak ("No name for escape sequence $_" ); | |
158 | } | |
159 | push (@result, $name); | |
160 | } | |
161 | @result; | |
162 | } | |
163 | ||
164 | # Given a string and a set of attributes, returns the string surrounded by | |
165 | # escape codes to set those attributes and then clear them at the end of the | |
166 | # string. The attributes can be given either as an array ref as the first | |
167 | # argument or as a list as the second and subsequent arguments. If $EACHLINE | |
168 | # is set, insert a reset before each occurrence of the string $EACHLINE and | |
169 | # the starting attribute code after the string $EACHLINE, so that no attribute | |
170 | # crosses line delimiters (this is often desirable if the output is to be | |
171 | # piped to a pager or some other program). | |
172 | sub colored { | |
173 | my ($string, @codes); | |
174 | if (ref $_[0]) { | |
175 | @codes = @{+shift}; | |
176 | $string = join ('', @_); | |
177 | } else { | |
178 | $string = shift; | |
179 | @codes = @_; | |
180 | } | |
181 | return $string if defined $ENV{ANSI_COLORS_DISABLED}; | |
182 | if (defined $EACHLINE) { | |
183 | my $attr = color (@codes); | |
184 | join '', | |
185 | map { $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ } | |
186 | grep { length ($_) > 0 } | |
187 | split (/(\Q$EACHLINE\E)/, $string); | |
188 | } else { | |
189 | color (@codes) . $string . "\e[0m"; | |
190 | } | |
191 | } | |
192 | ||
193 | ############################################################################## | |
194 | # Module return value and documentation | |
195 | ############################################################################## | |
196 | ||
197 | # Ensure we evaluate to true. | |
198 | 1; | |
199 | __END__ | |
200 | ||
201 | =head1 NAME | |
202 | ||
203 | Term::ANSIColor - Color screen output using ANSI escape sequences | |
204 | ||
205 | =head1 SYNOPSIS | |
206 | ||
207 | use Term::ANSIColor; | |
208 | print color 'bold blue'; | |
209 | print "This text is bold blue.\n"; | |
210 | print color 'reset'; | |
211 | print "This text is normal.\n"; | |
212 | print colored ("Yellow on magenta.\n", 'yellow on_magenta'); | |
213 | print "This text is normal.\n"; | |
214 | print colored ['yellow on_magenta'], "Yellow on magenta.\n"; | |
215 | ||
216 | use Term::ANSIColor qw(uncolor); | |
217 | print uncolor '01;31', "\n"; | |
218 | ||
219 | use Term::ANSIColor qw(:constants); | |
220 | print BOLD, BLUE, "This text is in bold blue.\n", RESET; | |
221 | ||
222 | use Term::ANSIColor qw(:constants); | |
223 | $Term::ANSIColor::AUTORESET = 1; | |
224 | print BOLD BLUE "This text is in bold blue.\n"; | |
225 | print "This text is normal.\n"; | |
226 | ||
227 | =head1 DESCRIPTION | |
228 | ||
229 | This module has two interfaces, one through color() and colored() and the | |
230 | other through constants. It also offers the utility function uncolor(), | |
231 | which has to be explicitly imported to be used (see L<SYNOPSIS>). | |
232 | ||
233 | color() takes any number of strings as arguments and considers them to be | |
234 | space-separated lists of attributes. It then forms and returns the escape | |
235 | sequence to set those attributes. It doesn't print it out, just returns it, | |
236 | so you'll have to print it yourself if you want to (this is so that you can | |
237 | save it as a string, pass it to something else, send it to a file handle, or | |
238 | do anything else with it that you might care to). | |
239 | ||
240 | uncolor() performs the opposite translation, turning escape sequences | |
241 | into a list of strings. | |
242 | ||
243 | The recognized attributes (all of which should be fairly intuitive) are | |
244 | clear, reset, dark, bold, underline, underscore, blink, reverse, concealed, | |
245 | black, red, green, yellow, blue, magenta, on_black, on_red, on_green, | |
246 | on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is not | |
247 | significant. Underline and underscore are equivalent, as are clear and | |
248 | reset, so use whichever is the most intuitive to you. The color alone sets | |
249 | the foreground color, and on_color sets the background color. | |
250 | ||
251 | Note that not all attributes are supported by all terminal types, and some | |
252 | terminals may not support any of these sequences. Dark, blink, and | |
253 | concealed in particular are frequently not implemented. | |
254 | ||
255 | Attributes, once set, last until they are unset (by sending the attribute | |
256 | "reset"). Be careful to do this, or otherwise your attribute will last | |
257 | after your script is done running, and people get very annoyed at having | |
258 | their prompt and typing changed to weird colors. | |
259 | ||
260 | As an aid to help with this, colored() takes a scalar as the first argument | |
261 | and any number of attribute strings as the second argument and returns the | |
262 | scalar wrapped in escape codes so that the attributes will be set as | |
263 | requested before the string and reset to normal after the string. | |
264 | Alternately, you can pass a reference to an array as the first argument, and | |
265 | then the contents of that array will be taken as attributes and color codes | |
266 | and the remainder of the arguments as text to colorize. | |
267 | ||
268 | Normally, colored() just puts attribute codes at the beginning and end of | |
269 | the string, but if you set $Term::ANSIColor::EACHLINE to some string, that | |
270 | string will be considered the line delimiter and the attribute will be set | |
271 | at the beginning of each line of the passed string and reset at the end of | |
272 | each line. This is often desirable if the output is being sent to a program | |
273 | like a pager that can be confused by attributes that span lines. Normally | |
274 | you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use this | |
275 | feature. | |
276 | ||
277 | Alternately, if you import C<:constants>, you can use the constants CLEAR, | |
278 | RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED, BLACK, | |
279 | RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE, ON_BLACK, ON_RED, ON_GREEN, | |
280 | ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are | |
281 | the same as color('attribute') and can be used if you prefer typing: | |
282 | ||
283 | print BOLD BLUE ON_WHITE "Text\n", RESET; | |
284 | ||
285 | to | |
286 | ||
287 | print colored ("Text\n", 'bold blue on_white'); | |
288 | ||
289 | When using the constants, if you don't want to have to remember to add the | |
290 | C<, RESET> at the end of each print line, you can set | |
291 | $Term::ANSIColor::AUTORESET to a true value. Then, the display mode will | |
292 | automatically be reset if there is no comma after the constant. In other | |
293 | words, with that variable set: | |
294 | ||
295 | print BOLD BLUE "Text\n"; | |
296 | ||
297 | will reset the display mode afterwards, whereas: | |
298 | ||
299 | print BOLD, BLUE, "Text\n"; | |
300 | ||
301 | will not. | |
302 | ||
303 | The subroutine interface has the advantage over the constants interface in | |
304 | that only two subroutines are exported into your namespace, versus | |
305 | twenty-two in the constants interface. On the flip side, the constants | |
306 | interface has the advantage of better compile time error checking, since | |
307 | misspelled names of colors or attributes in calls to color() and colored() | |
308 | won't be caught until runtime whereas misspelled names of constants will be | |
309 | caught at compile time. So, polute your namespace with almost two dozen | |
310 | subroutines that you may not even use that often, or risk a silly bug by | |
311 | mistyping an attribute. Your choice, TMTOWTDI after all. | |
312 | ||
313 | =head1 DIAGNOSTICS | |
314 | ||
315 | =over 4 | |
316 | ||
317 | =item Bad escape sequence %s | |
318 | ||
319 | (F) You passed an invalid ANSI escape sequence to uncolor(). | |
320 | ||
321 | =item Bareword "%s" not allowed while "strict subs" in use | |
322 | ||
323 | (F) You probably mistyped a constant color name such as: | |
324 | ||
325 | $Foobar = FOOBAR . "This line should be blue\n"; | |
326 | ||
327 | or: | |
328 | ||
329 | @Foobar = FOOBAR, "This line should be blue\n"; | |
330 | ||
331 | This will only show up under use strict (another good reason to run under | |
332 | use strict). | |
333 | ||
334 | =item Invalid attribute name %s | |
335 | ||
336 | (F) You passed an invalid attribute name to either color() or colored(). | |
337 | ||
338 | =item Name "%s" used only once: possible typo | |
339 | ||
340 | (W) You probably mistyped a constant color name such as: | |
341 | ||
342 | print FOOBAR "This text is color FOOBAR\n"; | |
343 | ||
344 | It's probably better to always use commas after constant names in order to | |
345 | force the next error. | |
346 | ||
347 | =item No comma allowed after filehandle | |
348 | ||
349 | (F) You probably mistyped a constant color name such as: | |
350 | ||
351 | print FOOBAR, "This text is color FOOBAR\n"; | |
352 | ||
353 | Generating this fatal compile error is one of the main advantages of using | |
354 | the constants interface, since you'll immediately know if you mistype a | |
355 | color name. | |
356 | ||
357 | =item No name for escape sequence %s | |
358 | ||
359 | (F) The ANSI escape sequence passed to uncolor() contains escapes which | |
360 | aren't recognized and can't be translated to names. | |
361 | ||
362 | =back | |
363 | ||
364 | =head1 ENVIRONMENT | |
365 | ||
366 | =over 4 | |
367 | ||
368 | =item ANSI_COLORS_DISABLED | |
369 | ||
370 | If this environment variable is set, all of the functions defined by this | |
371 | module (color(), colored(), and all of the constants not previously used in | |
372 | the program) will not output any escape sequences and instead will just | |
373 | return the empty string or pass through the original text as appropriate. | |
374 | This is intended to support easy use of scripts using this module on | |
375 | platforms that don't support ANSI escape sequences. | |
376 | ||
377 | For it to have its proper effect, this environment variable must be set | |
378 | before any color constants are used in the program. | |
379 | ||
380 | =back | |
381 | ||
382 | =head1 RESTRICTIONS | |
383 | ||
384 | It would be nice if one could leave off the commas around the constants | |
385 | entirely and just say: | |
386 | ||
387 | print BOLD BLUE ON_WHITE "Text\n" RESET; | |
388 | ||
389 | but the syntax of Perl doesn't allow this. You need a comma after the | |
390 | string. (Of course, you may consider it a bug that commas between all the | |
391 | constants aren't required, in which case you may feel free to insert commas | |
392 | unless you're using $Term::ANSIColor::AUTORESET.) | |
393 | ||
394 | For easier debuging, you may prefer to always use the commas when not | |
395 | setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile error | |
396 | rather than a warning. | |
397 | ||
398 | =head1 NOTES | |
399 | ||
400 | The codes generated by this module are standard terminal control codes, | |
401 | complying with ECMA-48 and ISO 6429 (generally referred to as "ANSI color" | |
402 | for the color codes). The non-color control codes (bold, dark, italic, | |
403 | underline, and reverse) are part of the earlier ANSI X3.64 standard for | |
404 | control sequences for video terminals and peripherals. | |
405 | ||
406 | Note that not all displays are ISO 6429-compliant, or even X3.64-compliant | |
407 | (or are even attempting to be so). This module will not work as expected on | |
408 | displays that do not honor these escape sequences, such as cmd.exe, 4nt.exe, | |
409 | and command.com under either Windows NT or Windows 2000. They may just be | |
410 | ignored, or they may display as an ESC character followed by some apparent | |
411 | garbage. | |
412 | ||
413 | Jean Delvare provided the following table of different common terminal | |
414 | emulators and their support for the various attributes and others have helped | |
415 | me flesh it out: | |
416 | ||
417 | clear bold dark under blink reverse conceal | |
418 | ------------------------------------------------------------------------ | |
419 | xterm yes yes no yes bold yes yes | |
420 | linux yes yes yes bold yes yes no | |
421 | rxvt yes yes no yes bold/black yes no | |
422 | dtterm yes yes yes yes reverse yes yes | |
423 | teraterm yes reverse no yes rev/red yes no | |
424 | aixterm kinda normal no yes no yes yes | |
425 | PuTTY yes color no yes no yes no | |
426 | Windows yes no no no no yes no | |
427 | Cygwin SSH yes yes no color color color yes | |
428 | Mac Terminal yes yes no yes yes yes yes | |
429 | ||
430 | Windows is Windows telnet, Cygwin SSH is the OpenSSH implementation under | |
431 | Cygwin on Windows NT, and Mac Terminal is the Terminal application in Mac OS | |
432 | X. Where the entry is other than yes or no, that emulator displays the | |
433 | given attribute as something else instead. Note that on an aixterm, clear | |
434 | doesn't reset colors; you have to explicitly set the colors back to what you | |
435 | want. More entries in this table are welcome. | |
436 | ||
437 | Note that codes 3 (italic), 6 (rapid blink), and 9 (strikethrough) are | |
438 | specified in ANSI X3.64 and ECMA-048 but are not commonly supported by most | |
439 | displays and emulators and therefore aren't supported by this module at the | |
440 | present time. ECMA-048 also specifies a large number of other attributes, | |
441 | including a sequence of attributes for font changes, Fraktur characters, | |
442 | double-underlining, framing, circling, and overlining. As none of these | |
443 | attributes are widely supported or useful, they also aren't currently | |
444 | supported by this module. | |
445 | ||
446 | =head1 SEE ALSO | |
447 | ||
448 | ECMA-048 is available on-line (at least at the time of this writing) at | |
449 | L<http://www.ecma-international.org/publications/standards/ECMA-048.HTM>. | |
450 | ||
451 | ISO 6429 is available from ISO for a charge; the author of this module does | |
452 | not own a copy of it. Since the source material for ISO 6429 was ECMA-048 | |
453 | and the latter is available for free, there seems little reason to obtain | |
454 | the ISO standard. | |
455 | ||
456 | The current version of this module is always available from its web site at | |
457 | L<http://www.eyrie.org/~eagle/software/ansicolor/>. It is also part of the | |
458 | Perl core distribution as of 5.6.0. | |
459 | ||
460 | =head1 AUTHORS | |
461 | ||
462 | Original idea (using constants) by Zenin, reimplemented using subs by Russ | |
463 | Allbery <rra@stanford.edu>, and then combined with the original idea by Russ | |
464 | with input from Zenin. Russ Allbery now maintains this module. | |
465 | ||
466 | =head1 COPYRIGHT AND LICENSE | |
467 | ||
468 | Copyright 1996, 1997, 1998, 2000, 2001, 2002 Russ Allbery <rra@stanford.edu> | |
469 | and Zenin. This program is free software; you may redistribute it and/or | |
470 | modify it under the same terms as Perl itself. | |
471 | ||
472 | =cut |