1# Term::ANSIColor -- Color screen output using ANSI escape sequences. 2# $Id: ANSIColor.pm,v 1.8 2004/02/20 06:21:26 eagle Exp $ 3# 4# Copyright 1996, 1997, 1998, 2000, 2001, 2002 5# by Russ Allbery <rra@stanford.edu> and Zenin <zenin@bawdycaste.com> 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 17package Term::ANSIColor; 18require 5.001; 19 20use strict; 21use vars qw($AUTOLOAD $AUTORESET $EACHLINE @ISA @EXPORT @EXPORT_OK 22 %EXPORT_TAGS $VERSION %attributes %attributes_r); 23 24use 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)]); 33Exporter::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.08; 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. 63for (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. 93sub 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. 121sub 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. 140sub 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). 172sub 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 split (/(\Q$EACHLINE\E)/, $string); 187 } else { 188 color (@codes) . $string . "\e[0m"; 189 } 190} 191 192############################################################################## 193# Module return value and documentation 194############################################################################## 195 196# Ensure we evaluate to true. 1971; 198__END__ 199 200=head1 NAME 201 202Term::ANSIColor - Color screen output using ANSI escape sequences 203 204=head1 SYNOPSIS 205 206 use Term::ANSIColor; 207 print color 'bold blue'; 208 print "This text is bold blue.\n"; 209 print color 'reset'; 210 print "This text is normal.\n"; 211 print colored ("Yellow on magenta.\n", 'yellow on_magenta'); 212 print "This text is normal.\n"; 213 print colored ['yellow on_magenta'], "Yellow on magenta.\n"; 214 215 use Term::ANSIColor qw(uncolor); 216 print uncolor '01;31', "\n"; 217 218 use Term::ANSIColor qw(:constants); 219 print BOLD, BLUE, "This text is in bold blue.\n", RESET; 220 221 use Term::ANSIColor qw(:constants); 222 $Term::ANSIColor::AUTORESET = 1; 223 print BOLD BLUE "This text is in bold blue.\n"; 224 print "This text is normal.\n"; 225 226=head1 DESCRIPTION 227 228This module has two interfaces, one through color() and colored() and the 229other through constants. It also offers the utility function uncolor(), 230which has to be explicitly imported to be used (see L<SYNOPSIS>). 231 232color() takes any number of strings as arguments and considers them to be 233space-separated lists of attributes. It then forms and returns the escape 234sequence to set those attributes. It doesn't print it out, just returns it, 235so you'll have to print it yourself if you want to (this is so that you can 236save it as a string, pass it to something else, send it to a file handle, or 237do anything else with it that you might care to). 238 239uncolor() performs the opposite translation, turning escape sequences 240into a list of strings. 241 242The recognized attributes (all of which should be fairly intuitive) are 243clear, reset, dark, bold, underline, underscore, blink, reverse, concealed, 244black, red, green, yellow, blue, magenta, on_black, on_red, on_green, 245on_yellow, on_blue, on_magenta, on_cyan, and on_white. Case is not 246significant. Underline and underscore are equivalent, as are clear and 247reset, so use whichever is the most intuitive to you. The color alone sets 248the foreground color, and on_color sets the background color. 249 250Note that not all attributes are supported by all terminal types, and some 251terminals may not support any of these sequences. Dark, blink, and 252concealed in particular are frequently not implemented. 253 254Attributes, once set, last until they are unset (by sending the attribute 255"reset"). Be careful to do this, or otherwise your attribute will last 256after your script is done running, and people get very annoyed at having 257their prompt and typing changed to weird colors. 258 259As an aid to help with this, colored() takes a scalar as the first argument 260and any number of attribute strings as the second argument and returns the 261scalar wrapped in escape codes so that the attributes will be set as 262requested before the string and reset to normal after the string. 263Alternately, you can pass a reference to an array as the first argument, and 264then the contents of that array will be taken as attributes and color codes 265and the remainder of the arguments as text to colorize. 266 267Normally, colored() just puts attribute codes at the beginning and end of 268the string, but if you set $Term::ANSIColor::EACHLINE to some string, that 269string will be considered the line delimiter and the attribute will be set 270at the beginning of each line of the passed string and reset at the end of 271each line. This is often desirable if the output is being sent to a program 272like a pager that can be confused by attributes that span lines. Normally 273you'll want to set $Term::ANSIColor::EACHLINE to C<"\n"> to use this 274feature. 275 276Alternately, if you import C<:constants>, you can use the constants CLEAR, 277RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED, BLACK, 278RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE, ON_BLACK, ON_RED, ON_GREEN, 279ON_YELLOW, ON_BLUE, ON_MAGENTA, ON_CYAN, and ON_WHITE directly. These are 280the same as color('attribute') and can be used if you prefer typing: 281 282 print BOLD BLUE ON_WHITE "Text\n", RESET; 283 284to 285 286 print colored ("Text\n", 'bold blue on_white'); 287 288When using the constants, if you don't want to have to remember to add the 289C<, RESET> at the end of each print line, you can set 290$Term::ANSIColor::AUTORESET to a true value. Then, the display mode will 291automatically be reset if there is no comma after the constant. In other 292words, with that variable set: 293 294 print BOLD BLUE "Text\n"; 295 296will reset the display mode afterwards, whereas: 297 298 print BOLD, BLUE, "Text\n"; 299 300will not. 301 302The subroutine interface has the advantage over the constants interface in 303that only two subroutines are exported into your namespace, versus 304twenty-two in the constants interface. On the flip side, the constants 305interface has the advantage of better compile time error checking, since 306misspelled names of colors or attributes in calls to color() and colored() 307won't be caught until runtime whereas misspelled names of constants will be 308caught at compile time. So, polute your namespace with almost two dozen 309subroutines that you may not even use that often, or risk a silly bug by 310mistyping an attribute. Your choice, TMTOWTDI after all. 311 312=head1 DIAGNOSTICS 313 314=over 4 315 316=item Bad escape sequence %s 317 318(F) You passed an invalid ANSI escape sequence to uncolor(). 319 320=item Bareword "%s" not allowed while "strict subs" in use 321 322(F) You probably mistyped a constant color name such as: 323 324 $Foobar = FOOBAR . "This line should be blue\n"; 325 326or: 327 328 @Foobar = FOOBAR, "This line should be blue\n"; 329 330This will only show up under use strict (another good reason to run under 331use strict). 332 333=item Invalid attribute name %s 334 335(F) You passed an invalid attribute name to either color() or colored(). 336 337=item Name "%s" used only once: possible typo 338 339(W) You probably mistyped a constant color name such as: 340 341 print FOOBAR "This text is color FOOBAR\n"; 342 343It's probably better to always use commas after constant names in order to 344force the next error. 345 346=item No comma allowed after filehandle 347 348(F) You probably mistyped a constant color name such as: 349 350 print FOOBAR, "This text is color FOOBAR\n"; 351 352Generating this fatal compile error is one of the main advantages of using 353the constants interface, since you'll immediately know if you mistype a 354color name. 355 356=item No name for escape sequence %s 357 358(F) The ANSI escape sequence passed to uncolor() contains escapes which 359aren't recognized and can't be translated to names. 360 361=back 362 363=head1 ENVIRONMENT 364 365=over 4 366 367=item ANSI_COLORS_DISABLED 368 369If this environment variable is set, all of the functions defined by this 370module (color(), colored(), and all of the constants not previously used in 371the program) will not output any escape sequences and instead will just 372return the empty string or pass through the original text as appropriate. 373This is intended to support easy use of scripts using this module on 374platforms that don't support ANSI escape sequences. 375 376For it to have its proper effect, this environment variable must be set 377before any color constants are used in the program. 378 379=back 380 381=head1 RESTRICTIONS 382 383It would be nice if one could leave off the commas around the constants 384entirely and just say: 385 386 print BOLD BLUE ON_WHITE "Text\n" RESET; 387 388but the syntax of Perl doesn't allow this. You need a comma after the 389string. (Of course, you may consider it a bug that commas between all the 390constants aren't required, in which case you may feel free to insert commas 391unless you're using $Term::ANSIColor::AUTORESET.) 392 393For easier debuging, you may prefer to always use the commas when not 394setting $Term::ANSIColor::AUTORESET so that you'll get a fatal compile error 395rather than a warning. 396 397=head1 NOTES 398 399The codes generated by this module are standard terminal control codes, 400complying with ECMA-48 and ISO 6429 (generally referred to as "ANSI color" 401for the color codes). The non-color control codes (bold, dark, italic, 402underline, and reverse) are part of the earlier ANSI X3.64 standard for 403control sequences for video terminals and peripherals. 404 405Note that not all displays are ISO 6429-compliant, or even X3.64-compliant 406(or are even attempting to be so). This module will not work as expected on 407displays that do not honor these escape sequences, such as cmd.exe, 4nt.exe, 408and command.com under either Windows NT or Windows 2000. They may just be 409ignored, or they may display as an ESC character followed by some apparent 410garbage. 411 412Jean Delvare provided the following table of different common terminal 413emulators and their support for the various attributes and others have helped 414me flesh it out: 415 416 clear bold dark under blink reverse conceal 417 ------------------------------------------------------------------------ 418 xterm yes yes no yes bold yes yes 419 linux yes yes yes bold yes yes no 420 rxvt yes yes no yes bold/black yes no 421 dtterm yes yes yes yes reverse yes yes 422 teraterm yes reverse no yes rev/red yes no 423 aixterm kinda normal no yes no yes yes 424 PuTTY yes color no yes no yes no 425 Windows yes no no no no yes no 426 Cygwin SSH yes yes no color color color yes 427 428Windows is Windows telnet, and Cygwin SSH is the OpenSSH implementation under 429Cygwin on Windows NT. Where the entry is other than yes or no, that emulator 430displays the given attribute as something else instead. Note that on an 431aixterm, clear doesn't reset colors; you have to explicitly set the colors 432back to what you want. More entries in this table are welcome. 433 434Note that codes 3 (italic), 6 (rapid blink), and 9 (strikethrough) are 435specified in ANSI X3.64 and ECMA-048 but are not commonly supported by most 436displays and emulators and therefore aren't supported by this module at the 437present time. ECMA-048 also specifies a large number of other attributes, 438including a sequence of attributes for font changes, Fraktur characters, 439double-underlining, framing, circling, and overlining. As none of these 440attributes are widely supported or useful, they also aren't currently 441supported by this module. 442 443=head1 SEE ALSO 444 445ECMA-048 is available on-line (at least at the time of this writing) at 446L<http://www.ecma-international.org/publications/standards/ECMA-048.HTM>. 447 448ISO 6429 is available from ISO for a charge; the author of this module does 449not own a copy of it. Since the source material for ISO 6429 was ECMA-048 450and the latter is available for free, there seems little reason to obtain 451the ISO standard. 452 453The current version of this module is always available from its web site at 454L<http://www.eyrie.org/~eagle/software/ansicolor/>. It is also part of the 455Perl core distribution as of 5.6.0. 456 457=head1 AUTHORS 458 459Original idea (using constants) by Zenin, reimplemented using subs by Russ 460Allbery <rra@stanford.edu>, and then combined with the original idea by Russ 461with input from Zenin. Russ Allbery now maintains this module. 462 463=head1 COPYRIGHT AND LICENSE 464 465Copyright 1996, 1997, 1998, 2000, 2001, 2002 Russ Allbery <rra@stanford.edu> 466and Zenin <zenin@bawdycaste.org>. This program is free software; you may 467redistribute it and/or modify it under the same terms as Perl itself. 468 469=cut 470