Commit | Line | Data |
---|---|---|
e3e5e1ea | 1 | # Term::ANSIColor -- Color screen output using ANSI escape sequences. |
f63addff | 2 | # $Id: ANSIColor.pm,v 1.3 2000/08/06 18:28:10 eagle Exp $ |
e3e5e1ea | 3 | # |
f63addff JH |
4 | # Copyright 1996, 1997, 1998, 2000 |
5 | # by Russ Allbery <rra@stanford.edu> and Zenin <zenin@best.com> | |
e3e5e1ea GS |
6 | # |
7 | # This program is free software; you can redistribute it and/or modify it | |
8 | # under the same terms as Perl itself. | |
f63addff JH |
9 | # |
10 | # Ah, September, when the sysadmins turn colors and fall off the trees.... | |
11 | # -- Dave Van Domelen | |
e3e5e1ea GS |
12 | |
13 | ############################################################################ | |
14 | # Modules and declarations | |
15 | ############################################################################ | |
16 | ||
17 | package Term::ANSIColor; | |
18 | require 5.001; | |
19 | ||
20 | use strict; | |
21 | use vars qw(@ISA @EXPORT %EXPORT_TAGS $VERSION $AUTOLOAD %attributes | |
22 | $AUTORESET $EACHLINE); | |
23 | ||
24 | use Exporter (); | |
25 | @ISA = qw(Exporter); | |
26 | @EXPORT = qw(color colored); | |
27 | %EXPORT_TAGS = (constants => [qw(CLEAR RESET BOLD UNDERLINE UNDERSCORE BLINK | |
28 | REVERSE CONCEALED BLACK RED GREEN YELLOW | |
29 | BLUE MAGENTA CYAN WHITE ON_BLACK ON_RED | |
30 | ON_GREEN ON_YELLOW ON_BLUE ON_MAGENTA | |
31 | ON_CYAN ON_WHITE)]); | |
32 | Exporter::export_ok_tags ('constants'); | |
f63addff JH |
33 | |
34 | # Don't use the CVS revision as the version, since this module is also in | |
35 | # Perl core and too many things could munge CVS magic revision strings. | |
36 | $VERSION = 1.03; | |
e3e5e1ea GS |
37 | |
38 | ||
39 | ############################################################################ | |
40 | # Internal data structures | |
41 | ############################################################################ | |
42 | ||
43 | %attributes = ('clear' => 0, | |
44 | 'reset' => 0, | |
45 | 'bold' => 1, | |
f63addff | 46 | 'dark' => 2, |
e3e5e1ea GS |
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 | ||
63 | ############################################################################ | |
64 | # Implementation (constant form) | |
65 | ############################################################################ | |
66 | ||
67 | # Time to have fun! We now want to define the constant subs, which are | |
68 | # named the same as the attributes above but in all caps. Each constant sub | |
69 | # needs to act differently depending on whether $AUTORESET is set. Without | |
70 | # autoreset: | |
71 | # | |
72 | # BLUE "text\n" ==> "\e[34mtext\n" | |
73 | # | |
74 | # If $AUTORESET is set, we should instead get: | |
75 | # | |
76 | # BLUE "text\n" ==> "\e[34mtext\n\e[0m" | |
77 | # | |
78 | # The sub also needs to handle the case where it has no arguments correctly. | |
79 | # Maintaining all of this as separate subs would be a major nightmare, as | |
80 | # well as duplicate the %attributes hash, so instead we define an AUTOLOAD | |
81 | # sub to define the constant subs on demand. To do that, we check the name | |
82 | # of the called sub against the list of attributes, and if it's an all-caps | |
83 | # version of one of them, we define the sub on the fly and then run it. | |
84 | sub AUTOLOAD { | |
85 | my $sub; | |
86 | ($sub = $AUTOLOAD) =~ s/^.*:://; | |
87 | my $attr = $attributes{lc $sub}; | |
88 | if ($sub =~ /^[A-Z_]+$/ && defined $attr) { | |
89 | $attr = "\e[" . $attr . 'm'; | |
90 | eval qq { | |
91 | sub $AUTOLOAD { | |
92 | if (\$AUTORESET && \@_) { | |
93 | '$attr' . "\@_" . "\e[0m"; | |
94 | } else { | |
95 | ('$attr' . "\@_"); | |
96 | } | |
97 | } | |
98 | }; | |
99 | goto &$AUTOLOAD; | |
100 | } else { | |
f63addff JH |
101 | require Carp; |
102 | Carp::croak ("undefined subroutine &$AUTOLOAD called"); | |
e3e5e1ea GS |
103 | } |
104 | } | |
105 | ||
106 | ||
107 | ############################################################################ | |
108 | # Implementation (attribute string form) | |
109 | ############################################################################ | |
110 | ||
111 | # Return the escape code for a given set of color attributes. | |
112 | sub color { | |
113 | my @codes = map { split } @_; | |
114 | my $attribute = ''; | |
115 | foreach (@codes) { | |
116 | $_ = lc $_; | |
117 | unless (defined $attributes{$_}) { | |
118 | require Carp; | |
119 | Carp::croak ("Invalid attribute name $_"); | |
120 | } | |
121 | $attribute .= $attributes{$_} . ';'; | |
122 | } | |
123 | chop $attribute; | |
124 | ($attribute ne '') ? "\e[${attribute}m" : undef; | |
125 | } | |
126 | ||
127 | # Given a string and a set of attributes, returns the string surrounded by | |
128 | # escape codes to set those attributes and then clear them at the end of the | |
f63addff JH |
129 | # string. The attributes can be given either as an array ref as the first |
130 | # argument or as a list as the second and subsequent arguments. If | |
131 | # $EACHLINE is set, insert a reset before each occurrence of the string | |
132 | # $EACHLINE and the starting attribute code after the string $EACHLINE, so | |
133 | # that no attribute crosses line delimiters (this is often desirable if the | |
134 | # output is to be piped to a pager or some other program). | |
e3e5e1ea | 135 | sub colored { |
f63addff JH |
136 | my ($string, @codes); |
137 | if (ref $_[0]) { | |
138 | @codes = @{+shift}; | |
139 | $string = join ('', @_); | |
140 | } else { | |
141 | $string = shift; | |
142 | @codes = @_; | |
143 | } | |
e3e5e1ea | 144 | if (defined $EACHLINE) { |
f63addff | 145 | my $attr = color (@codes); |
e3e5e1ea GS |
146 | join '', |
147 | map { $_ && $_ ne $EACHLINE ? $attr . $_ . "\e[0m" : $_ } | |
148 | split (/(\Q$EACHLINE\E)/, $string); | |
149 | } else { | |
f63addff | 150 | color (@codes) . $string . "\e[0m"; |
e3e5e1ea GS |
151 | } |
152 | } | |
153 | ||
154 | ||
155 | ############################################################################ | |
156 | # Module return value and documentation | |
157 | ############################################################################ | |
158 | ||
159 | # Ensure we evaluate to true. | |
160 | 1; | |
161 | __END__ | |
162 | ||
163 | =head1 NAME | |
164 | ||
165 | Term::ANSIColor - Color screen output using ANSI escape sequences | |
166 | ||
167 | =head1 SYNOPSIS | |
168 | ||
169 | use Term::ANSIColor; | |
170 | print color 'bold blue'; | |
171 | print "This text is bold blue.\n"; | |
172 | print color 'reset'; | |
173 | print "This text is normal.\n"; | |
174 | print colored ("Yellow on magenta.\n", 'yellow on_magenta'); | |
175 | print "This text is normal.\n"; | |
f63addff | 176 | print colored ['yellow on_magenta'], "Yellow on magenta.\n"; |
e3e5e1ea GS |
177 | |
178 | use Term::ANSIColor qw(:constants); | |
179 | print BOLD, BLUE, "This text is in bold blue.\n", RESET; | |
180 | ||
181 | use Term::ANSIColor qw(:constants); | |
182 | $Term::ANSIColor::AUTORESET = 1; | |
183 | print BOLD BLUE "This text is in bold blue.\n"; | |
184 | print "This text is normal.\n"; | |
185 | ||
186 | =head1 DESCRIPTION | |
187 | ||
188 | This module has two interfaces, one through color() and colored() and the | |
189 | other through constants. | |
bbc7dcd2 | 190 | |
e3e5e1ea GS |
191 | color() takes any number of strings as arguments and considers them to be |
192 | space-separated lists of attributes. It then forms and returns the escape | |
193 | sequence to set those attributes. It doesn't print it out, just returns | |
194 | it, so you'll have to print it yourself if you want to (this is so that | |
195 | you can save it as a string, pass it to something else, send it to a file | |
196 | handle, or do anything else with it that you might care to). | |
197 | ||
198 | The recognized attributes (all of which should be fairly intuitive) are | |
f63addff JH |
199 | clear, reset, dark, bold, underline, underscore, blink, reverse, |
200 | concealed, black, red, green, yellow, blue, magenta, on_black, on_red, | |
201 | on_green, on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is | |
202 | not significant. Underline and underscore are equivalent, as are clear | |
203 | and reset, so use whichever is the most intuitive to you. The color alone | |
e3e5e1ea GS |
204 | sets the foreground color, and on_color sets the background color. |
205 | ||
f63addff JH |
206 | Note that not all attributes are supported by all terminal types, and some |
207 | terminals may not support any of these sequences. Dark, blink, and | |
208 | concealed in particular are frequently not implemented. | |
209 | ||
210 | Attributes, once set, last until they are unset (by sending the attribute | |
211 | "reset"). Be careful to do this, or otherwise your attribute will last | |
212 | after your script is done running, and people get very annoyed at having | |
213 | their prompt and typing changed to weird colors. | |
e3e5e1ea GS |
214 | |
215 | As an aid to help with this, colored() takes a scalar as the first | |
216 | argument and any number of attribute strings as the second argument and | |
217 | returns the scalar wrapped in escape codes so that the attributes will be | |
218 | set as requested before the string and reset to normal after the string. | |
f63addff JH |
219 | Alternately, you can pass a reference to an array as the first argument, |
220 | and then the contents of that array will be taken as attributes and color | |
221 | codes and the remainder of the arguments as text to colorize. | |
222 | ||
e3e5e1ea GS |
223 | Normally, colored() just puts attribute codes at the beginning and end of |
224 | the string, but if you set $Term::ANSIColor::EACHLINE to some string, | |
225 | that string will be considered the line delimiter and the attribute will | |
226 | be set at the beginning of each line of the passed string and reset at the | |
227 | end of each line. This is often desirable if the output is being sent to | |
228 | a program like a pager that can be confused by attributes that span lines. | |
229 | Normally you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use | |
230 | this feature. | |
231 | ||
232 | Alternately, if you import C<:constants>, you can use the constants CLEAR, | |
f63addff JH |
233 | RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED, |
234 | BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, ON_BLACK, ON_RED, ON_GREEN, | |
235 | ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are | |
236 | the same as color('attribute') and can be used if you prefer typing: | |
e3e5e1ea GS |
237 | |
238 | print BOLD BLUE ON_WHITE "Text\n", RESET; | |
239 | ||
240 | to | |
241 | ||
242 | print colored ("Text\n", 'bold blue on_white'); | |
243 | ||
244 | When using the constants, if you don't want to have to remember to add the | |
245 | C<, RESET> at the end of each print line, you can set | |
246 | $Term::ANSIColor::AUTORESET to a true value. Then, the display mode will | |
247 | automatically be reset if there is no comma after the constant. In other | |
248 | words, with that variable set: | |
249 | ||
250 | print BOLD BLUE "Text\n"; | |
251 | ||
252 | will reset the display mode afterwards, whereas: | |
253 | ||
254 | print BOLD, BLUE, "Text\n"; | |
255 | ||
256 | will not. | |
257 | ||
258 | The subroutine interface has the advantage over the constants interface in | |
f63addff JH |
259 | that only two subroutines are exported into your namespace, versus |
260 | twenty-two in the constants interface. On the flip side, the constants | |
261 | interface has the advantage of better compile time error checking, since | |
262 | misspelled names of colors or attributes in calls to color() and colored() | |
263 | won't be caught until runtime whereas misspelled names of constants will | |
264 | be caught at compile time. So, polute your namespace with almost two | |
265 | dozen subroutines that you may not even use that often, or risk a silly | |
266 | bug by mistyping an attribute. Your choice, TMTOWTDI after all. | |
e3e5e1ea GS |
267 | |
268 | =head1 DIAGNOSTICS | |
269 | ||
270 | =over 4 | |
271 | ||
272 | =item Invalid attribute name %s | |
273 | ||
f63addff | 274 | (F) You passed an invalid attribute name to either color() or colored(). |
e3e5e1ea | 275 | |
f63addff | 276 | =item Name "%s" used only once: possible typo |
e3e5e1ea | 277 | |
f63addff | 278 | (W) You probably mistyped a constant color name such as: |
e3e5e1ea GS |
279 | |
280 | print FOOBAR "This text is color FOOBAR\n"; | |
281 | ||
282 | It's probably better to always use commas after constant names in order to | |
283 | force the next error. | |
284 | ||
285 | =item No comma allowed after filehandle | |
286 | ||
f63addff | 287 | (F) You probably mistyped a constant color name such as: |
e3e5e1ea GS |
288 | |
289 | print FOOBAR, "This text is color FOOBAR\n"; | |
290 | ||
291 | Generating this fatal compile error is one of the main advantages of using | |
292 | the constants interface, since you'll immediately know if you mistype a | |
293 | color name. | |
294 | ||
f63addff | 295 | =item Bareword "%s" not allowed while "strict subs" in use |
e3e5e1ea | 296 | |
f63addff | 297 | (F) You probably mistyped a constant color name such as: |
e3e5e1ea GS |
298 | |
299 | $Foobar = FOOBAR . "This line should be blue\n"; | |
300 | ||
301 | or: | |
302 | ||
303 | @Foobar = FOOBAR, "This line should be blue\n"; | |
304 | ||
305 | This will only show up under use strict (another good reason to run under | |
306 | use strict). | |
307 | ||
308 | =back | |
309 | ||
310 | =head1 RESTRICTIONS | |
311 | ||
312 | It would be nice if one could leave off the commas around the constants | |
313 | entirely and just say: | |
314 | ||
315 | print BOLD BLUE ON_WHITE "Text\n" RESET; | |
316 | ||
317 | but the syntax of Perl doesn't allow this. You need a comma after the | |
318 | string. (Of course, you may consider it a bug that commas between all the | |
319 | constants aren't required, in which case you may feel free to insert | |
320 | commas unless you're using $Term::ANSIColor::AUTORESET.) | |
321 | ||
322 | For easier debuging, you may prefer to always use the commas when not | |
323 | setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile | |
324 | error rather than a warning. | |
325 | ||
f63addff JH |
326 | =head1 NOTES |
327 | ||
328 | Jean Delvare provided the following table of different common terminal | |
329 | emulators and their support for the various attributes: | |
330 | ||
331 | clear bold dark under blink reverse conceal | |
332 | ------------------------------------------------------------------------ | |
333 | xterm yes yes no yes bold yes yes | |
334 | linux yes yes yes bold yes yes no | |
335 | rxvt yes yes no yes bold/black yes no | |
336 | dtterm yes yes yes yes reverse yes yes | |
337 | teraterm yes reverse no yes rev/red yes no | |
338 | aixterm kinda normal no yes no yes yes | |
339 | ||
340 | Where the entry is other than yes or no, that emulator interpret the given | |
341 | attribute as something else instead. Note that on an aixterm, clear | |
342 | doesn't reset colors; you have to explicitly set the colors back to what | |
343 | you want. More entries in this table are welcome. | |
344 | ||
e3e5e1ea GS |
345 | =head1 AUTHORS |
346 | ||
347 | Original idea (using constants) by Zenin (zenin@best.com), reimplemented | |
348 | using subs by Russ Allbery (rra@stanford.edu), and then combined with the | |
349 | original idea by Russ with input from Zenin. | |
350 | ||
351 | =cut |