lib/Term/ANSIColor.pm

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