cpan/Term-ANSIColor/ANSIColor.pm Perl module supporting termcap usage
cpan/Term-ANSIColor/ChangeLog Term::ANSIColor
cpan/Term-ANSIColor/README Term::ANSIColor
+cpan/Term-ANSIColor/t/aliases-func.t
+cpan/Term-ANSIColor/t/basic256.t
cpan/Term-ANSIColor/t/basic.t Tests for Term::ANSIColor
cpan/Term-ANSIColor/t/eval.t
cpan/Term-ANSIColor/t/stringify.t Tests for Term::ANSIColor
+cpan/Term-ANSIColor/t/taint.t
cpan/Term-Cap/Cap.pm Perl module supporting termcap usage
cpan/Term-Cap/test.pl See if Term::Cap works
cpan/Term-UI/lib/Term/UI/History.pm Term::UI
'Term::ANSIColor' => {
'MAINTAINER' => 'rra',
- 'DISTRIBUTION' => 'RRA/Term-ANSIColor-3.02.tar.gz',
+ 'DISTRIBUTION' => 'RRA/Term-ANSIColor-4.01.tar.gz',
'FILES' => q[cpan/Term-ANSIColor],
'EXCLUDED' => [
qr{^tests/},
# Term::ANSIColor -- Color screen output using ANSI escape sequences.
#
# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
-# 2011, 2012 Russ Allbery <rra@stanford.edu> and Zenin
-# PUSH/POP support submitted 2007 by openmethods.com voice solutions
+# 2011, 2012 Russ Allbery <rra@stanford.edu>
+# Copyright 1996 Zenin
+# Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
#
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
#
+# PUSH/POP support submitted 2007 by openmethods.com voice solutions
+#
# Ah, September, when the sysadmins turn colors and fall off the trees....
# -- Dave Van Domelen
##############################################################################
package Term::ANSIColor;
-require 5.001;
-
-$VERSION = '3.02';
+use 5.006;
use strict;
-use vars qw($AUTOLOAD $AUTOLOCAL $AUTORESET @COLORLIST @COLORSTACK $EACHLINE
- @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $VERSION %ATTRIBUTES
- %ATTRIBUTES_R);
+use warnings;
+use Carp qw(croak);
use Exporter ();
+
+# use Exporter plus @ISA instead of use base for 5.6 compatibility.
+## no critic (ClassHierarchies::ProhibitExplicitISA)
+
+# Declare variables that should be set in BEGIN for robustness.
+## no critic (Modules::ProhibitAutomaticExportation)
+our (@EXPORT, @EXPORT_OK, %EXPORT_TAGS, @ISA, $VERSION);
+
+# We use autoloading, which sets this variable to the name of the called sub.
+our $AUTOLOAD;
+
+# Set $VERSION and everything export-related in a BEGIN block for robustness
+# against circular module loading (not that we load any modules, but
+# consistency is good).
BEGIN {
- @COLORLIST = qw(
- CLEAR RESET BOLD DARK
- FAINT ITALIC UNDERLINE UNDERSCORE
- BLINK REVERSE CONCEALED
-
- BLACK RED GREEN YELLOW
- BLUE MAGENTA CYAN WHITE
- ON_BLACK ON_RED ON_GREEN ON_YELLOW
- ON_BLUE ON_MAGENTA ON_CYAN ON_WHITE
-
- BRIGHT_BLACK BRIGHT_RED BRIGHT_GREEN BRIGHT_YELLOW
- BRIGHT_BLUE BRIGHT_MAGENTA BRIGHT_CYAN BRIGHT_WHITE
- ON_BRIGHT_BLACK ON_BRIGHT_RED ON_BRIGHT_GREEN ON_BRIGHT_YELLOW
- ON_BRIGHT_BLUE ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN ON_BRIGHT_WHITE
+ $VERSION = '4.01';
+
+ # All of the basic supported constants, used in %EXPORT_TAGS.
+ my @colorlist = qw(
+ CLEAR RESET BOLD DARK
+ FAINT ITALIC UNDERLINE UNDERSCORE
+ BLINK REVERSE CONCEALED
+
+ BLACK RED GREEN YELLOW
+ BLUE MAGENTA CYAN WHITE
+ ON_BLACK ON_RED ON_GREEN ON_YELLOW
+ ON_BLUE ON_MAGENTA ON_CYAN ON_WHITE
+
+ BRIGHT_BLACK BRIGHT_RED BRIGHT_GREEN BRIGHT_YELLOW
+ BRIGHT_BLUE BRIGHT_MAGENTA BRIGHT_CYAN BRIGHT_WHITE
+ ON_BRIGHT_BLACK ON_BRIGHT_RED ON_BRIGHT_GREEN ON_BRIGHT_YELLOW
+ ON_BRIGHT_BLUE ON_BRIGHT_MAGENTA ON_BRIGHT_CYAN ON_BRIGHT_WHITE
);
+
+ # 256-color constants, used in %EXPORT_TAGS.
+ ## no critic (ValuesAndExpressions::ProhibitMagicNumbers)
+ my @colorlist256 = (
+ (map { ("ANSI$_", "ON_ANSI$_") } 0 .. 15),
+ (map { ("GREY$_", "ON_GREY$_") } 0 .. 23),
+ );
+ for my $r (0 .. 5) {
+ for my $g (0 .. 5) {
+ push @colorlist256, map { ("RGB$r$g$_", "ON_RGB$r$g$_") } 0 .. 5;
+ }
+ }
+
+ # Exported symbol configuration.
@ISA = qw(Exporter);
@EXPORT = qw(color colored);
- @EXPORT_OK = qw(uncolor colorstrip colorvalid);
- %EXPORT_TAGS = (constants => \@COLORLIST,
- pushpop => [ @COLORLIST,
- qw(PUSHCOLOR POPCOLOR LOCALCOLOR) ]);
- Exporter::export_ok_tags ('pushpop');
+ @EXPORT_OK = qw(uncolor colorstrip colorvalid coloralias);
+ %EXPORT_TAGS = (
+ constants => \@colorlist,
+ constants256 => \@colorlist256,
+ pushpop => [@colorlist, qw(PUSHCOLOR POPCOLOR LOCALCOLOR)],
+ );
+ Exporter::export_ok_tags('pushpop', 'constants256');
}
##############################################################################
+# Package variables
+##############################################################################
+
+# If this is set, any color changes will implicitly push the current color
+# onto the stack and then pop it at the end of the constant sequence, just as
+# if LOCALCOLOR were used.
+our $AUTOLOCAL;
+
+# Caller sets this to force a reset at the end of each constant sequence.
+our $AUTORESET;
+
+# Caller sets this to force colors to be reset at the end of each line.
+our $EACHLINE;
+
+##############################################################################
# Internal data structures
##############################################################################
-%ATTRIBUTES = ('clear' => 0,
- 'reset' => 0,
- 'bold' => 1,
- 'dark' => 2,
- 'faint' => 2,
- 'italic' => 3,
- 'underline' => 4,
- 'underscore' => 4,
- 'blink' => 5,
- 'reverse' => 7,
- 'concealed' => 8,
-
- 'black' => 30, 'on_black' => 40,
- 'red' => 31, 'on_red' => 41,
- 'green' => 32, 'on_green' => 42,
- 'yellow' => 33, 'on_yellow' => 43,
- 'blue' => 34, 'on_blue' => 44,
- 'magenta' => 35, 'on_magenta' => 45,
- 'cyan' => 36, 'on_cyan' => 46,
- 'white' => 37, 'on_white' => 47,
-
- 'bright_black' => 90, 'on_bright_black' => 100,
- 'bright_red' => 91, 'on_bright_red' => 101,
- 'bright_green' => 92, 'on_bright_green' => 102,
- 'bright_yellow' => 93, 'on_bright_yellow' => 103,
- 'bright_blue' => 94, 'on_bright_blue' => 104,
- 'bright_magenta' => 95, 'on_bright_magenta' => 105,
- 'bright_cyan' => 96, 'on_bright_cyan' => 106,
- 'bright_white' => 97, 'on_bright_white' => 107,
- );
+# This module does quite a bit of initialization at the time it is first
+# loaded, primarily to set up the package-global %ATTRIBUTES hash. The
+# entries for 256-color names are easier to handle programmatically, and
+# custom colors are also imported from the environment if any are set.
+
+# All basic supported attributes, including aliases.
+#<<<
+our %ATTRIBUTES = (
+ 'clear' => 0,
+ 'reset' => 0,
+ 'bold' => 1,
+ 'dark' => 2,
+ 'faint' => 2,
+ 'italic' => 3,
+ 'underline' => 4,
+ 'underscore' => 4,
+ 'blink' => 5,
+ 'reverse' => 7,
+ 'concealed' => 8,
+
+ 'black' => 30, 'on_black' => 40,
+ 'red' => 31, 'on_red' => 41,
+ 'green' => 32, 'on_green' => 42,
+ 'yellow' => 33, 'on_yellow' => 43,
+ 'blue' => 34, 'on_blue' => 44,
+ 'magenta' => 35, 'on_magenta' => 45,
+ 'cyan' => 36, 'on_cyan' => 46,
+ 'white' => 37, 'on_white' => 47,
+
+ 'bright_black' => 90, 'on_bright_black' => 100,
+ 'bright_red' => 91, 'on_bright_red' => 101,
+ 'bright_green' => 92, 'on_bright_green' => 102,
+ 'bright_yellow' => 93, 'on_bright_yellow' => 103,
+ 'bright_blue' => 94, 'on_bright_blue' => 104,
+ 'bright_magenta' => 95, 'on_bright_magenta' => 105,
+ 'bright_cyan' => 96, 'on_bright_cyan' => 106,
+ 'bright_white' => 97, 'on_bright_white' => 107,
+);
+#>>>
+
+# Generating the 256-color codes involves a lot of codes and offsets that are
+# not helped by turning them into constants.
+## no critic (ValuesAndExpressions::ProhibitMagicNumbers)
+
+# The first 16 256-color codes are duplicates of the 16 ANSI colors,
+# included for completeness.
+for my $code (0 .. 15) {
+ $ATTRIBUTES{"ansi$code"} = "38;5;$code";
+ $ATTRIBUTES{"on_ansi$code"} = "48;5;$code";
+}
+
+# 256-color RGB colors. Red, green, and blue can each be values 0 through 5,
+# and the resulting 216 colors start with color 16.
+for my $r (0 .. 5) {
+ for my $g (0 .. 5) {
+ for my $b (0 .. 5) {
+ my $code = 16 + (6 * 6 * $r) + (6 * $g) + $b;
+ $ATTRIBUTES{"rgb$r$g$b"} = "38;5;$code";
+ $ATTRIBUTES{"on_rgb$r$g$b"} = "48;5;$code";
+ }
+ }
+}
+
+# The last 256-color codes are 24 shades of grey.
+for my $n (0 .. 23) {
+ my $code = $n + 232;
+ $ATTRIBUTES{"grey$n"} = "38;5;$code";
+ $ATTRIBUTES{"on_grey$n"} = "48;5;$code";
+}
+
+## use critic (ValuesAndExpressions::ProhibitMagicNumbers)
# Reverse lookup. Alphabetically first name for a sequence is preferred.
-for (reverse sort keys %ATTRIBUTES) {
- $ATTRIBUTES_R{$ATTRIBUTES{$_}} = $_;
+our %ATTRIBUTES_R;
+for my $attr (reverse sort keys %ATTRIBUTES) {
+ $ATTRIBUTES_R{ $ATTRIBUTES{$attr} } = $attr;
+}
+
+# Import any custom colors set in the environment.
+our %ALIASES;
+if (exists $ENV{ANSI_COLORS_ALIASES}) {
+ my $spec = $ENV{ANSI_COLORS_ALIASES};
+ $spec =~ s{\s+}{}xmsg;
+
+ # Error reporting here is an interesting question. Use warn rather than
+ # carp because carp would report the line of the use or require, which
+ # doesn't help anyone understand what's going on, whereas seeing this code
+ # will be more helpful.
+ ## no critic (ErrorHandling::RequireCarping)
+ for my $definition (split m{,}xms, $spec) {
+ my ($new, $old) = split m{=}xms, $definition, 2;
+ if (!$new || !$old) {
+ warn qq{Bad color mapping "$definition"};
+ } else {
+ my $result = eval { coloralias($new, $old) };
+ if (!$result) {
+ my $error = $@;
+ $error =~ s{ [ ] at [ ] .* }{}xms;
+ warn qq{$error in "$definition"};
+ }
+ }
+ }
}
+# Stores the current color stack maintained by PUSHCOLOR and POPCOLOR. This
+# is global and therefore not threadsafe.
+our @COLORSTACK;
+
##############################################################################
# Implementation (constant form)
##############################################################################
# called sub against the list of attributes, and if it's an all-caps version
# of one of them, we define the sub on the fly and then run it.
#
-# If the environment variable ANSI_COLORS_DISABLED is set, just return the
-# arguments without adding any escape sequences. This is to make it easier to
-# write scripts that also work on systems without any ANSI support, like
-# Windows consoles.
+# If the environment variable ANSI_COLORS_DISABLED is set to a true value,
+# just return the arguments without adding any escape sequences. This is to
+# make it easier to write scripts that also work on systems without any ANSI
+# support, like Windows consoles.
+#
+## no critic (ClassHierarchies::ProhibitAutoloading)
+## no critic (Subroutines::RequireArgUnpacking)
sub AUTOLOAD {
- if ($AUTOLOAD =~ /^([\w:]*::([A-Z_]+))$/ and defined $ATTRIBUTES{lc $2}) {
- if (defined $ENV{ANSI_COLORS_DISABLED}) {
- return join ('', @_);
- }
- $AUTOLOAD = $1;
- my $attr = "\e[" . $ATTRIBUTES{lc $2} . 'm';
- my $saved = $@;
- eval qq {
- sub $AUTOLOAD {
- if (\$AUTORESET && \@_) {
- return '$attr' . join ('', \@_) . "\e[0m";
- } elsif (\$AUTOLOCAL && \@_) {
- return PUSHCOLOR ('$attr') . join ('', \@_) . POPCOLOR;
- } else {
- return '$attr' . join ('', \@_);
- }
+ my ($sub, $attr) = $AUTOLOAD =~ m{ \A ([\w:]*::([[:upper:]\d_]+)) \z }xms;
+
+ # Check if we were called with something that doesn't look like an
+ # attribute.
+ if (!$attr || !defined $ATTRIBUTES{ lc $attr }) {
+ croak("undefined subroutine &$AUTOLOAD called");
+ }
+
+ # If colors are disabled, just return the input. Do this without
+ # installing a sub for (marginal, unbenchmarked) speed.
+ if ($ENV{ANSI_COLORS_DISABLED}) {
+ return join q{}, @_;
+ }
+
+ # We've untainted the name of the sub.
+ $AUTOLOAD = $sub;
+
+ # Figure out the ANSI string to set the desired attribute.
+ my $escape = "\e[" . $ATTRIBUTES{ lc $attr } . 'm';
+
+ # Save the current value of $@. We can't just use local since we want to
+ # restore it before dispatching to the newly-created sub. (The caller may
+ # be colorizing output that includes $@.)
+ my $eval_err = $@;
+
+ # Generate the constant sub, which should still recognize some of our
+ # package variables. Use string eval to avoid a dependency on
+ # Sub::Install, even though it makes it somewhat less readable.
+ ## no critic (BuiltinFunctions::ProhibitStringyEval)
+ ## no critic (ValuesAndExpressions::ProhibitImplicitNewlines)
+ my $eval_result = eval qq{
+ sub $AUTOLOAD {
+ if (\$ENV{ANSI_COLORS_DISABLED}) {
+ return join q{}, \@_;
+ } elsif (\$AUTOLOCAL && \@_) {
+ return PUSHCOLOR('$escape') . join(q{}, \@_) . POPCOLOR;
+ } elsif (\$AUTORESET && \@_) {
+ return '$escape' . join(q{}, \@_) . "\e[0m";
+ } else {
+ return '$escape' . join q{}, \@_;
}
- };
- die "failed to generate constant $1" if $@;
- $@ = $saved;
- goto &$AUTOLOAD;
- } else {
- require Carp;
- Carp::croak ("undefined subroutine &$AUTOLOAD called");
+ }
+ 1;
+ };
+
+ # Failure is an internal error, not a problem with the caller.
+ ## no critic (ErrorHandling::RequireCarping)
+ if (!$eval_result) {
+ die "failed to generate constant $attr: $@";
}
+
+ # Restore $@.
+ ## no critic (Variables::RequireLocalizedPunctuationVars)
+ $@ = $eval_err;
+
+ # Dispatch to the newly-created sub.
+ ## no critic (References::ProhibitDoubleSigils)
+ goto &$AUTOLOAD;
}
+## use critic (Subroutines::RequireArgUnpacking)
# Append a new color to the top of the color stack and return the top of
# the stack.
+#
+# $text - Any text we're applying colors to, with color escapes prepended
+#
+# Returns: The text passed in
sub PUSHCOLOR {
- my ($text) = @_;
- my ($color) = ($text =~ m/^((?:\e\[[\d;]+m)+)/);
+ my (@text) = @_;
+ my $text = join q{}, @text;
+
+ # Extract any number of color-setting escape sequences from the start of
+ # the string.
+ my ($color) = $text =~ m{ \A ( (?:\e\[ [\d;]+ m)+ ) }xms;
+
+ # If we already have a stack, append these escapes to the set from the top
+ # of the stack. This way, each position in the stack stores the complete
+ # enabled colors for that stage, at the cost of some potential
+ # inefficiency.
if (@COLORSTACK) {
$color = $COLORSTACK[-1] . $color;
}
- push (@COLORSTACK, $color);
+
+ # Push the color onto the stack.
+ push @COLORSTACK, $color;
return $text;
}
# Pop the color stack and return the new top of the stack (or reset, if
# the stack is empty).
+#
+# @text - Any text we're applying colors to
+#
+# Returns: The concatenation of @text prepended with the new stack color
sub POPCOLOR {
+ my (@text) = @_;
pop @COLORSTACK;
if (@COLORSTACK) {
- return $COLORSTACK[-1] . join ('', @_);
+ return $COLORSTACK[-1] . join q{}, @text;
} else {
- return RESET (@_);
+ return RESET(@text);
}
}
-# Surround arguments with a push and a pop.
+# Surround arguments with a push and a pop. The effect will be to reset the
+# colors to whatever was on the color stack before this sequence of colors was
+# applied.
+#
+# @text - Any text we're applying colors to
+#
+# Returns: The concatenation of the text and the proper color reset sequence.
sub LOCALCOLOR {
- return PUSHCOLOR (join ('', @_)) . POPCOLOR ();
+ my (@text) = @_;
+ return PUSHCOLOR(join q{}, @text) . POPCOLOR();
}
##############################################################################
##############################################################################
# Return the escape code for a given set of color attributes.
+#
+# @codes - A list of possibly space-separated color attributes
+#
+# Returns: The escape sequence setting those color attributes
+# undef if no escape sequences were given
+# Throws: Text exception for any invalid attribute
sub color {
- return '' if defined $ENV{ANSI_COLORS_DISABLED};
- my @codes = map { split } @_;
- my $attribute = '';
- foreach (@codes) {
- $_ = lc $_;
- unless (defined $ATTRIBUTES{$_}) {
- require Carp;
- Carp::croak ("Invalid attribute name $_");
+ my (@codes) = @_;
+ @codes = map { split } @codes;
+
+ # Return the empty string if colors are disabled.
+ if ($ENV{ANSI_COLORS_DISABLED}) {
+ return q{};
+ }
+
+ # Build the attribute string from semicolon-separated numbers.
+ my $attribute = q{};
+ for my $code (@codes) {
+ $code = lc $code;
+ if (defined $ATTRIBUTES{$code}) {
+ $attribute .= $ATTRIBUTES{$code} . q{;};
+ } elsif (defined $ALIASES{$code}) {
+ $attribute .= $ALIASES{$code} . q{;};
+ } else {
+ croak("Invalid attribute name $code");
}
- $attribute .= $ATTRIBUTES{$_} . ';';
}
+
+ # We added one too many semicolons for simplicity. Remove the last one.
chop $attribute;
- return ($attribute ne '') ? "\e[${attribute}m" : undef;
+
+ # Return undef if there were no attributes.
+ return ($attribute ne q{}) ? "\e[${attribute}m" : undef;
}
# Return a list of named color attributes for a given set of escape codes.
# Escape sequences can be given with or without enclosing "\e[" and "m". The
# empty escape sequence '' or "\e[m" gives an empty list of attrs.
+#
+# There is one special case. 256-color codes start with 38 or 48, followed by
+# a 5 and then the 256-color code.
+#
+# @escapes - A list of escape sequences or escape sequence numbers
+#
+# Returns: An array of attribute names corresponding to those sequences
+# Throws: Text exceptions on invalid escape sequences or unknown colors
sub uncolor {
+ my (@escapes) = @_;
my (@nums, @result);
- for (@_) {
- my $escape = $_;
- $escape =~ s/^\e\[//;
- $escape =~ s/m$//;
- unless ($escape =~ /^((?:\d+;)*\d*)$/) {
- require Carp;
- Carp::croak ("Bad escape sequence $escape");
+
+ # Walk the list of escapes and build a list of attribute numbers.
+ for my $escape (@escapes) {
+ $escape =~ s{ \A \e\[ }{}xms;
+ $escape =~ s{ m \z } {}xms;
+ my ($attrs) = $escape =~ m{ \A ((?:\d+;)* \d*) \z }xms;
+ if (!defined $attrs) {
+ croak("Bad escape sequence $escape");
}
- push (@nums, split (/;/, $1));
+
+ # Pull off 256-color codes (38;5;n or 48;5;n) as a unit.
+ push @nums, $attrs =~ m{ ( 0*[34]8;0*5;\d+ | \d+ ) (?: ; | \z ) }xmsg;
}
- for (@nums) {
- $_ += 0; # Strip leading zeroes
- my $name = $ATTRIBUTES_R{$_};
+
+ # Now, walk the list of numbers and convert them to attribute names.
+ # Strip leading zeroes from any of the numbers. (xterm, at least, allows
+ # leading zeroes to be added to any number in an escape sequence.)
+ for my $num (@nums) {
+ $num =~ s{ ( \A | ; ) 0+ (\d) }{$1$2}xmsg;
+ my $name = $ATTRIBUTES_R{$num};
if (!defined $name) {
- require Carp;
- Carp::croak ("No name for escape sequence $_" );
+ croak("No name for escape sequence $num");
}
- push (@result, $name);
+ push @result, $name;
}
+
+ # Return the attribute names.
return @result;
}
# Given a string and a set of attributes, returns the string surrounded by
# escape codes to set those attributes and then clear them at the end of the
# string. The attributes can be given either as an array ref as the first
-# argument or as a list as the second and subsequent arguments. If $EACHLINE
-# is set, insert a reset before each occurrence of the string $EACHLINE and
-# the starting attribute code after the string $EACHLINE, so that no attribute
-# crosses line delimiters (this is often desirable if the output is to be
-# piped to a pager or some other program).
+# argument or as a list as the second and subsequent arguments.
+#
+# If $EACHLINE is set, insert a reset before each occurrence of the string
+# $EACHLINE and the starting attribute code after the string $EACHLINE, so
+# that no attribute crosses line delimiters (this is often desirable if the
+# output is to be piped to a pager or some other program).
+#
+# $first - An anonymous array of attributes or the text to color
+# @rest - The text to color or the list of attributes
+#
+# Returns: The text, concatenated if necessary, surrounded by escapes to set
+# the desired colors and reset them afterwards
+# Throws: Text exception on invalid attributes
sub colored {
+ my ($first, @rest) = @_;
my ($string, @codes);
- if (ref ($_[0]) && ref ($_[0]) eq 'ARRAY') {
- @codes = @{+shift};
- $string = join ('', @_);
+ if (ref($first) && ref($first) eq 'ARRAY') {
+ @codes = @{$first};
+ $string = join q{}, @rest;
} else {
- $string = shift;
- @codes = @_;
+ $string = $first;
+ @codes = @rest;
+ }
+
+ # Return the string unmolested if colors are disabled.
+ if ($ENV{ANSI_COLORS_DISABLED}) {
+ return $string;
}
- return $string if defined $ENV{ANSI_COLORS_DISABLED};
+
+ # Find the attribute string for our colors.
+ my $attr = color(@codes);
+
+ # If $EACHLINE is defined, split the string on line boundaries, suppress
+ # empty segments, and then colorize each of the line sections.
if (defined $EACHLINE) {
- my $attr = color (@codes);
- return join '',
- map { ($_ ne $EACHLINE) ? $attr . $_ . "\e[0m" : $_ }
- grep { length ($_) > 0 }
- split (/(\Q$EACHLINE\E)/, $string);
+ my @text = map { ($_ ne $EACHLINE) ? $attr . $_ . "\e[0m" : $_ }
+ grep { length($_) > 0 }
+ split m{ (\Q$EACHLINE\E) }xms, $string;
+ return join q{}, @text;
} else {
- return color (@codes) . $string . "\e[0m";
+ return $attr . $string . "\e[0m";
+ }
+}
+
+# Define a new color alias, or return the value of an existing alias.
+#
+# $alias - The color alias to define
+# $color - The standard color the alias will correspond to (optional)
+#
+# Returns: The standard color value of the alias
+# undef if one argument was given and the alias was not recognized
+# Throws: Text exceptions for invalid alias names, attempts to use a
+# standard color name as an alias, or an unknown standard color name
+sub coloralias {
+ my ($alias, $color) = @_;
+ if (!defined $color) {
+ if (!exists $ALIASES{$alias}) {
+ return;
+ } else {
+ return $ATTRIBUTES_R{ $ALIASES{$alias} };
+ }
+ }
+ if ($alias !~ m{ \A [\w._-]+ \z }xms) {
+ croak(qq{Invalid alias name "$alias"});
+ } elsif ($ATTRIBUTES{$alias}) {
+ croak(qq{Cannot alias standard color "$alias"});
+ } elsif (!exists $ATTRIBUTES{$color}) {
+ croak(qq{Invalid attribute name "$color"});
}
+ $ALIASES{$alias} = $ATTRIBUTES{$color};
+ return $color;
}
# Given a string, strip the ANSI color codes out of that string and return the
# result. This removes only ANSI color codes, not movement codes and other
# escape sequences.
+#
+# @string - The list of strings to sanitize
+#
+# Returns: (array) The strings stripped of ANSI color escape sequences
+# (scalar) The same, concatenated
sub colorstrip {
my (@string) = @_;
for my $string (@string) {
- $string =~ s/\e\[[\d;]*m//g;
+ $string =~ s{ \e\[ [\d;]* m }{}xmsg;
}
- return wantarray ? @string : join ('', @string);
+ return wantarray ? @string : join q{}, @string;
}
# Given a list of color attributes (arguments for color, for instance), return
# true if they're all valid or false if any of them are invalid.
+#
+# @codes - A list of color attributes, possibly space-separated
+#
+# Returns: True if all the attributes are valid, false otherwise.
sub colorvalid {
- my @codes = map { split } @_;
- for (@codes) {
- unless (defined $ATTRIBUTES{lc $_}) {
+ my (@codes) = @_;
+ @codes = map { split q{ }, lc $_ } @codes;
+ for my $code (@codes) {
+ if (!defined $ATTRIBUTES{$code} && !defined $ALIASES{$code}) {
return;
}
}
cyan colorize namespace runtime TMTOWTDI cmd.exe 4nt.exe command.com NT
ESC Delvare SSH OpenSSH aixterm ECMA-048 Fraktur overlining Zenin
reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com
-grey ATTR urxvt mistyped
+grey ATTR urxvt mistyped prepending Bareword filehandle Cygwin Starsinic
+aterm rxvt CPAN RGB Solarized Whitespace alphanumerics undef
=head1 SYNOPSIS
print "This text is bold blue.\n";
print color 'reset';
print "This text is normal.\n";
- print colored ("Yellow on magenta.", 'yellow on_magenta'), "\n";
+ print colored("Yellow on magenta.", 'yellow on_magenta'), "\n";
print "This text is normal.\n";
print colored ['yellow on_magenta'], 'Yellow on magenta.', "\n";
print colored ['red on_bright_yellow'], 'Red on bright yellow.', "\n";
print colored ['bright_red on_black'], 'Bright red on black.', "\n";
print "\n";
- use Term::ANSIColor qw(uncolor);
- print uncolor ('01;31'), "\n";
+ # Map escape sequences back to color names.
+ use Term::ANSIColor 1.04 qw(uncolor);
+ my $names = uncolor('01;31');
+ print join(q{ }, @{$names}), "\n";
- use Term::ANSIColor qw(colorstrip);
+ # Strip all color escape sequences.
+ use Term::ANSIColor 2.01 qw(colorstrip);
print colorstrip '\e[1mThis is bold\e[0m', "\n";
- use Term::ANSIColor qw(colorvalid);
- my $valid = colorvalid ('blue bold', 'on_magenta');
+ # Determine whether a color is valid.
+ use Term::ANSIColor 2.02 qw(colorvalid);
+ my $valid = colorvalid('blue bold', 'on_magenta');
print "Color string is ", $valid ? "valid\n" : "invalid\n";
+ # Create new aliases for colors.
+ use Term::ANSIColor 4.00 qw(coloralias);
+ coloralias('alert', 'red');
+ print "Alert is ", coloralias('alert'), "\n";
+ print colored("This is in red.", 'alert'), "\n";
+
use Term::ANSIColor qw(:constants);
print BOLD, BLUE, "This text is in bold blue.\n", RESET;
print "This text is normal.\n";
}
- use Term::ANSIColor qw(:pushpop);
+ use Term::ANSIColor 2.00 qw(:pushpop);
print PUSHCOLOR RED ON_GREEN "This text is red on green.\n";
print PUSHCOLOR BRIGHT_BLUE "This text is bright blue on green.\n";
print RESET BRIGHT_BLUE "This text is just bright blue.\n";
This module has two interfaces, one through color() and colored() and the
other through constants. It also offers the utility functions uncolor(),
-colorstrip(), and colorvalid(), which have to be explicitly imported to be
-used (see L</SYNOPSIS>).
+colorstrip(), colorvalid(), and coloralias(), which have to be explicitly
+imported to be used (see L</SYNOPSIS>).
+
+See L</COMPATIBILITY> for the versions of Term::ANSIColor that introduced
+particular features and the versions of Perl that included them.
=head2 Supported Colors
Terminal emulators that support color divide into two types: ones that
-support only eight colors, and ones that support sixteen. This module
-provides both the ANSI escape codes for the "normal" colors, supported by
-both types, as well as the additional colors supported by sixteen-color
-emulators. These colors are referred to as ANSI colors 0 through 7
-(normal) and 8 through 15.
+support only eight colors, ones that support sixteen, and ones that
+support 256. This module provides the ANSI escape codes all of them.
+These colors are referred to as ANSI colors 0 through 7 (normal), 8
+through 15 (16-color), and 16 through 255 (256-color).
Unfortunately, interpretation of colors 0 through 7 often depends on
whether the emulator supports eight colors or sixteen colors. Emulators
background colors: C<on_red> is the normal color and C<on_bright_red> is
the bright color. Capitalize these strings for the constant interface.
+For 256-color emulators, this module additionally provides C<ansi0>
+through C<ansi15>, which are the same as colors 0 through 15 in
+sixteen-color emulators but use the 256-color escape syntax, C<grey0>
+through C<grey23> ranging from nearly black to nearly white, and a set of
+RGB colors. The RGB colors are of the form C<rgbI<RGB>> where I<R>, I<G>,
+and I<B> are numbers from 0 to 5 giving the intensity of red, green, and
+blue. C<on_> variants of all of these colors are also provided. These
+colors may be ignored completely on non-256-color terminals or may be
+misinterpreted and produce random behavior. Additional attributes such as
+blink, italic, or bold may not work with the 256-color palette.
+
There is unfortunately no way to know whether the current emulator
-supports sixteen colors or not, which makes the choice of colors
+supports more than eight colors, which makes the choice of colors
difficult. The most conservative choice is to use only the regular
colors, which are at least displayed on all emulators. However, they will
appear dark in sixteen-color terminal emulators, including most common
offer the user a way to configure the colors for a given application to
fit their terminal emulator.
-Support for colors 8 through 15 (the C<bright_> variants) was added in
-Term::ANSIColor 3.0.
-
=head2 Function Interface
The function interface uses attribute strings to describe the colors and
terminals may not support any of these sequences. Dark and faint, italic,
blink, and concealed in particular are frequently not implemented.
-Support for italic was added in Term::ANSIColor 3.02.
-
The recognized normal foreground color attributes (colors 0 to 7) are:
black red green yellow blue magenta cyan white
on_bright_black on_bright_red on_bright_green on_bright_yellow
on_bright_blue on_bright_magenta on_bright_cyan on_bright_white
+For 256-color terminals, the recognized foreground colors are:
+
+ ansi0 .. ansi15
+ grey0 .. grey23
+
+plus C<rgbI<RGB>> for I<R>, I<G>, and I<B> values from 0 to 5, such as
+C<rgb000> or C<rgb515>. Similarly, the recognized background colors are:
+
+ on_ansi0 .. on_ansi15
+ on_grey0 .. on_grey23
+
+plus C<on_rgbI<RGB>> for for I<R>, I<G>, and I<B> values from 0 to 5.
+
For any of the above listed attributes, case is not significant.
Attributes, once set, last until they are unset (by printing the attribute
handle, or do anything else with it that you might care to. color()
throws an exception if given an invalid attribute.
-=item colored(STRING, ATTRIBUTES)
+=item colored(STRING, ATTR[, ATTR ...])
=item colored(ATTR-REF, STRING[, STRING...])
colorvalid() takes attribute strings the same as color() and returns true
if all attributes are known and false otherwise.
+=item coloralias(ALIAS[, ATTR])
+
+If ATTR is specified, coloralias() sets up an alias of ALIAS for the
+standard color ATTR. From that point forward, ALIAS can be passed into
+color(), colored(), and colorvalid() and will have the same meaning as
+ATTR. One possible use of this facility is to give more meaningful names
+to the 256-color RGB colors. Only alphanumerics, C<.>, C<_>, and C<-> are
+allowed in alias names.
+
+If ATTR is not specified, coloralias() returns the standard color name to
+which ALIAS is aliased, if any, or undef if ALIAS does not exist.
+
+This is the same facility used by the ANSI_COLORS_ALIASES environment
+variable (see L</ENVIRONMENT> below) but can be used at runtime, not just
+when the module is loaded.
+
+Later invocations of coloralias() with the same ALIAS will override
+earlier aliases. There is no way to remove an alias.
+
+Aliases have no effect on the return value of uncolor().
+
+B<WARNING>: Aliases are global and affect all callers in the same process.
+There is no way to set an alias limited to a particular block of code or a
+particular object.
+
=back
=head2 Constant Interface
(Note that the newline is kept separate to avoid confusing the terminal as
described above since a background color is being used.)
-Support for C<ITALIC> was added in Term::ANSIColor 3.02.
+If you import C<:constants256>, you can use the following constants
+directly:
+
+ ANSI0 .. ANSI15
+ GREY0 .. GREY23
+
+ RGBXYZ (for X, Y, and Z values from 0 to 5, like RGB000 or RGB515)
+
+ ON_ANSI0 .. ON_ANSI15
+ ON_GREY0 .. ON_GREY23
+
+ ON_RGBXYZ (for X, Y, and Z values from 0 to 5)
+
+Note that C<:constants256> does not include the other constants, so if you
+want to mix both, you need to include C<:constants> as well. You may want
+to explicitly import at least C<RESET>, as in:
+
+ use Term::ANSIColor 4.00 qw(RESET :constants256);
When using the constants, if you don't want to have to remember to add the
C<, RESET> at the end of each print line, you can set
print BOLD, BLUE, "Text\n";
will not. If you are using background colors, you will probably want to
-print the newline with a separate print statement to avoid confusing the
-terminal.
+either use say() (in newer versions of Perl) or print the newline with a
+separate print statement to avoid confusing the terminal.
+
+If $Term::ANSIColor::AUTOLOCAL is set (see below), it takes precedence
+over $Term::ANSIColor::AUTORESET, and the latter is ignored.
The subroutine interface has the advantage over the constants interface in
that only two subroutines are exported into your namespace, versus
=head2 The Color Stack
-As of Term::ANSIColor 2.0, you can import C<:pushpop> and maintain a stack
-of colors using PUSHCOLOR, POPCOLOR, and LOCALCOLOR. PUSHCOLOR takes the
-attribute string that starts its argument and pushes it onto a stack of
-attributes. POPCOLOR removes the top of the stack and restores the
-previous attributes set by the argument of a prior PUSHCOLOR. LOCALCOLOR
-surrounds its argument in a PUSHCOLOR and POPCOLOR so that the color
-resets afterward.
+You can import C<:pushpop> and maintain a stack of colors using PUSHCOLOR,
+POPCOLOR, and LOCALCOLOR. PUSHCOLOR takes the attribute string that
+starts its argument and pushes it onto a stack of attributes. POPCOLOR
+removes the top of the stack and restores the previous attributes set by
+the argument of a prior PUSHCOLOR. LOCALCOLOR surrounds its argument in a
+PUSHCOLOR and POPCOLOR so that the color resets afterward.
+
+If $Term::ANSIColor::AUTOLOCAL is set, each sequence of color constants
+will be implicitly preceded by LOCALCOLOR. In other words, the following:
+
+ {
+ local $Term::ANSIColor::AUTOLOCAL = 1;
+ print BLUE "Text\n";
+ }
+
+is equivalent to:
+
+ print LOCALCOLOR BLUE "Text\n";
+
+If $Term::ANSIColor::AUTOLOCAL is set, it takes precedence over
+$Term::ANSIColor::AUTORESET, and the latter is ignored.
When using PUSHCOLOR, POPCOLOR, and LOCALCOLOR, it's particularly
important to not put commas between the constants.
=over 4
+=item Bad color mapping %s
+
+(W) The specified color mapping from ANSI_COLORS_ALIASES is not valid and
+could not be parsed. It was ignored.
+
=item Bad escape sequence %s
(F) You passed an invalid ANSI escape sequence to uncolor().
This will only show up under use strict (another good reason to run under
use strict).
+=item Cannot alias standard color %s
+
+(F) The alias name passed to coloralias() matches a standard color name.
+Standard color names cannot be aliased.
+
+=item Cannot alias standard color %s in %s
+
+(W) The same, but in ANSI_COLORS_ALIASES. The color mapping was ignored.
+
+=item Invalid alias name %s
+
+(F) You passed an invalid alias name to coloralias(). Alias names must
+consist only of alphanumerics, C<.>, C<->, and C<_>.
+
+=item Invalid alias name %s in %s
+
+(W) You specified an invalid alias name on the left hand of the equal sign
+in a color mapping in ANSI_COLORS_ALIASES. The color mapping was ignored.
+
=item Invalid attribute name %s
-(F) You passed an invalid attribute name to either color() or colored().
+(F) You passed an invalid attribute name to color(), colored(), or
+coloralias().
+
+=item Invalid attribute name %s in %s
+
+(W) You specified an invalid attribute name on the right hand of the equal
+sign in a color mapping in ANSI_COLORS_ALIASES. The color mapping was
+ignored.
=item Name "%s" used only once: possible typo
=over 4
-=item ANSI_COLORS_DISABLED
+=item ANSI_COLORS_ALIASES
+
+This environment variable allows the user to specify custom color aliases
+that will be understood by color(), colored(), and colorvalid(). None of
+the other functions will be affected, and no new color constants will be
+created. The custom colors are aliases for existing color names; no new
+escape sequences can be introduced. Only alphanumerics, C<.>, C<_>, and
+C<-> are allowed in alias names.
+
+The format is:
+
+ ANSI_COLORS_ALIASES='newcolor1=oldcolor1,newcolor2=oldcolor2'
-If this environment variable is set, all of the functions defined by this
-module (color(), colored(), and all of the constants not previously used
-in the program) will not output any escape sequences and instead will just
-return the empty string or pass through the original text as appropriate.
-This is intended to support easy use of scripts using this module on
-platforms that don't support ANSI escape sequences.
+Whitespace is ignored.
+
+For example the L<Solarized|http://ethanschoonover.com/solarized> colors
+can be mapped with:
+
+ ANSI_COLORS_ALIASES='\
+ base00=bright_yellow, on_base00=on_bright_yellow,\
+ base01=bright_green, on_base01=on_bright_green, \
+ base02=black, on_base02=on_black, \
+ base03=bright_black, on_base03=on_bright_black, \
+ base0=bright_blue, on_base0=on_bright_blue, \
+ base1=bright_cyan, on_base1=on_bright_cyan, \
+ base2=white, on_base2=on_white, \
+ base3=bright_white, on_base3=on_bright_white, \
+ orange=bright_red, on_orange=on_bright_red, \
+ violet=bright_magenta,on_violet=on_bright_magenta'
+
+This environment variable is read and applied when the Term::ANSIColor
+module is loaded and is then subsequently ignored. Changes to
+ANSI_COLORS_ALIASES after the module is loaded will have no effect. See
+coloralias() for an equivalent facility that can be used at runtime.
+
+=item ANSI_COLORS_DISABLED
-For it to have its proper effect, this environment variable must be set
-before any color constants are used in the program.
+If this environment variable is set to a true value, all of the functions
+defined by this module (color(), colored(), and all of the constants not
+previously used in the program) will not output any escape sequences and
+instead will just return the empty string or pass through the original
+text as appropriate. This is intended to support easy use of scripts
+using this module on platforms that don't support ANSI escape sequences.
=back
+=head1 COMPATIBILITY
+
+Term::ANSIColor was first included with Perl in Perl 5.6.0.
+
+The uncolor() function and support for ANSI_COLORS_DISABLED were added in
+Term::ANSIColor 1.04, included in Perl 5.8.0.
+
+Support for dark was added in Term::ANSIColor 1.08, included in Perl
+5.8.4.
+
+The color stack, including the C<:pushpop> import tag, PUSHCOLOR,
+POPCOLOR, LOCALCOLOR, and the $Term::ANSIColor::AUTOLOCAL variable, was
+added in Term::ANSIColor 2.00, included in Perl 5.10.1.
+
+colorstrip() was added in Term::ANSIColor 2.01 and colorvalid() was added
+in Term::ANSIColor 2.02, both included in Perl 5.11.0.
+
+Support for colors 8 through 15 (the C<bright_> variants) was added in
+Term::ANSIColor 3.00, included in Perl 5.13.3.
+
+Support for italic was added in Term::ANSIColor 3.02, included in Perl
+5.17.1.
+
+Support for colors 16 through 256 (the C<ansi>, C<rgb>, and C<grey>
+colors), the C<:constants256> import tag, the coloralias() function, and
+support for the ANSI_COLORS_ALIASES environment variable were added in
+Term::ANSIColor 4.00.
+
+$Term::ANSIColor::AUTOLOCAL was changed to take precedence over
+$Term::ANSIColor::AUTORESET, rather than the other way around, in
+Term::ANSIColor 4.00.
+
=head1 RESTRICTIONS
It would be nice if one could leave off the commas around the constants
PuTTY yes color no yes no yes no
Windows yes no no no no yes no
Cygwin SSH yes yes no color color color yes
- Mac Terminal yes yes no yes yes yes yes
+ Terminal.app yes yes no yes yes yes yes
Windows is Windows telnet, Cygwin SSH is the OpenSSH implementation under
Cygwin on Windows NT, and Mac Terminal is the Terminal application in Mac
attributes are widely supported or useful, they also aren't currently
supported by this module.
+Most modern X terminal emulators support 256 colors. Known to not support
+those colors are aterm, rxvt, Terminal.app, and TTY/VC.
+
=head1 SEE ALSO
ECMA-048 is available on-line (at least at the time of this writing) at
ECMA-048 and the latter is available for free, there seems little reason
to obtain the ISO standard.
+The 256-color control sequences are documented at
+L<http://www.xfree86.org/current/ctlseqs.html> (search for 256-color).
+
+The CPAN module Term::ExtendedColor provides a different and more
+comprehensive interface for 256-color emulators that may be more
+convenient.
+
The current version of this module is always available from its web site
at L<http://www.eyrie.org/~eagle/software/ansicolor/>. It is also part of
the Perl core distribution as of 5.6.0.
Original idea (using constants) by Zenin, reimplemented using subs by Russ
Allbery <rra@stanford.edu>, and then combined with the original idea by
-Russ with input from Zenin. Russ Allbery now maintains this module.
+Russ with input from Zenin. 256-color support is based on work by Kurt
+Starsinic. Russ Allbery now maintains this module.
+
+PUSHCOLOR, POPCOLOR, and LOCALCOLOR were contributed by openmethods.com
+voice solutions.
=head1 COPYRIGHT AND LICENSE
-Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009,
-2010, 2011, 2012 Russ Allbery <rra@stanford.edu> and Zenin. This program
-is free software; you may redistribute it and/or modify it under the same
+Copyright 1996 Zenin. Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005,
+2006, 2008, 2009, 2010, 2011, 2012 Russ Allbery <rra@stanford.edu>.
+Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>. This program is
+free software; you may redistribute it and/or modify it under the same
terms as Perl itself.
-PUSHCOLOR, POPCOLOR, and LOCALCOLOR were contributed by openmethods.com
-voice solutions.
-
=cut
+2012-12-31 Russ Allbery <rra@stanford.edu>
+
+ * ANSIColor.pm: Version 4.01 released.
+
+ * t/strict.t: During coverage checking, skip generic tests that
+ don't run module code for a significant speed-up.
+
+ * examples/generate-colors: Add POD documentation.
+ * t/critic.t: Also check the examples directory.
+ * t/pod.t: Likewise.
+ * t/pod-spelling.t: Likewise.
+
+ * t/aliases-env.t: Fix logic for skipping tests when Test::Warn is
+ not installed.
+
+2012-12-30 Russ Allbery <rra@stanford.edu>
+
+ * ANSIColor.pm: Version 4.00 released.
+
+ * LICENSE: New file summarizing copyright and license information.
+
+ * examples/generate-colors: Add support for "basic" and "bright"
+ test file types that test all the other supported attributes.
+ * tests/README: Remove VT100 test files. The license was unclear,
+ and the new generate-colors example script does everything they do
+ of significance for this package plus more.
+ * tests/ansicolor: Likewise.
+ * tests/vt100-torture: Likewise.
+
+ * ANSIColor.pm (PUSHCOLOR): Take an array like all the other
+ constant functions and join all arguments together before
+ manipulating it.
+ * t/basic.t: Multiple new tests for various weird edge cases.
+
+ * ANSIColor.pm (AUTOLOAD): Only honor ANSI_COLORS_DISABLED if it
+ is set to a true value.
+ (color): Likewise.
+ (colored): Likewise.
+ * t/basic.t: Test that ANSI_COLORS_DISABLED must be true.
+
+ * t/synopsis.t: New test for SYNOPSIS syntax.
+
+ * ANSIColor.pm: Add COMPATIBILITY section to the documentation,
+ collecting all information about when features were introduced and
+ adding the version of Perl that they shipped with. Add
+ appropriate version numbers to the use statements in the SYNOPSIS.
+
+ * ANSIColor.pm: Use coloralias to load aliases from the
+ environment. Improve commenting in the SYNOPSIS. Document the
+ new alias name restrictions.
+ (coloralias): New function to set a color alias. Enforce
+ restrictions on the acceptable alias name.
+
+ * t/aliases-env.t: Adjust warning test for new error message.
+ * t/aliases-func.t: New test of coloralias.
+
+2012-12-29 Stephen Thirlwall <stephen.thirlwall@strategicdata.com.au>
+ Russ Allbery <rra@stanford.edu>
+
+ * ANSIColor.pm: Add support for custom color names configured with
+ the ANSI_COLORS_ALIASES environment variable as set during module
+ load.
+ (color): Support custom colors.
+ (colorvalid): Likewise.
+ * t/aliases-env.t: New test of custom colors from the environment.
+ * t/basic.t: Delete ANSI_COLORS_ALIASES from the environment before
+ module load to avoid any effects from the test runner's settings.
+ * t/basic256.t: Likewise.
+ * t/eval.t: Likewise.
+ * t/stringify.t: Likewise.
+ * t/taint.t: Likewise.
+
+2012-12-28 Kurt Starsinic <kstarsinic@gmail.com>
+ Russ Allbery <rra@stanford.edu>
+
+ * ANSIColor.pm: Add constants (with tag :constants256) and
+ attributes for 256-color emulators.
+ (uncolor): Support the three-part 256-color codes.
+ * t/basic256.t: New test for 256-color support.
+ * examples/generate-colors: New script to generate 256-color test
+ or demonstration files.
+
+2012-12-28 Russ Allbery <rra@stanford.edu>
+
+ * t/basic.t: Test uncolor with \e[m and '' as only arguments.
+
+ * ANSIColor.pm: $AUTOLOCAL takes precedence over $AUTORESET,
+ reversing the previous behvior. Document the precedence.
+ * t/basic.t: Test for $AUTOLOCAL vs. $AUTORESET precedence.
+
+ * t/taint.t: New check for proper untainting in AUTOLOAD.
+ * ANSIColor.pm: Comment the untainting of $AUTOLOAD so that it
+ isn't accidentally removed as apparently unnecessary.
+
+ * t/strict.t: Ignore t/taint.t for coverage checking, since
+ Test::Strict doesn't know how to invoke tests that require
+ tainting.
+
+ * t/strict.t: Add test suite coverage checking if running the test
+ in maintainer mode.
+ * ANSIColor.pm (AUTOLOAD): Drop a redundant check on the result of
+ eval so that 100% test coverage can be achieved.
+ * t/basic.t: Remove taint checking, which is incompatible with
+ coverage testing. Add tests to achieve 100% coverage.
+ * t/eval.t: Remove taint checking.
+ * t/stringify.t: Likewise.
+
+ * ANSIColor.pm: Document $Term::ANSIColor::AUTOLOCAL.
+
+ * ANSIColor.pm (AUTOLOAD): Support ANSI_COLORS_DISABLED in the
+ generated constant subs. Fixes a bug where the environment
+ variable would be ignored if the constant were used before it was
+ set.
+ * t/basic.t: Test for proper ANSI_COLORS_DISABLED support in
+ generated constant subs.
+
+ * t/critic.t: New test that runs perlcritic (and perltidy) on all
+ source files and checks for violations.
+ * t/data/perlcriticrc: New file.
+ * t/data/perltidyrc: New file.
+ * ANSIColor.pm: Substantial reworking to improve coding style and
+ layout. Update to Perl 5.6 syntax. Unconditionally load Carp for
+ simplicity.
+ * Makefile.PL: Require Perl 5.6. Remove conditionals for
+ configuration that was not supported prior to Perl 5.6.
+ * t/basic.t: Update coding style.
+ * t/eval.t: Likewise.
+ * t/stringify.t: Likewise.
+
+ * t/minimum-version.t: New test for the minimum required version
+ of Perl.
+
+ * t/pod-coverage.t: New test for POD coverage.
+
+ * ANSIColor.pm: Add use warnings.
+ * Makefile.PL: Add use strict and use warnings.
+ * t/strict.t: New test for strict and warnings in all code.
+
+ * t/pod.t: Update coding style.
+ * t/pod-spelling.t: Use Test::Spelling instead of including a
+ less-tested version of the same code. Update coding style.
+
2012-03-18 Russ Allbery <rra@stanford.edu>
* ANSIColor.pm: Version 3.02 released.
- Term::ANSIColor version 3.02
+ Term::ANSIColor version 4.01
(A simple ANSI text attribute control module)
- Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2007, 2009,
- 2010, 2011, 2012 Russ Allbery <rra@stanford.edu> and Zenin. This
- program is free software; you may redistribute it and/or modify it under
- the same terms as Perl itself.
-
- I welcome bug reports and patches for this package at rra@stanford.edu
- or via the CPAN bug tracker at <http://rt.cpan.org/>. However, please
- be aware that I tend to be extremely busy and to get a lot of mail.
- I'll save your mail and get to it as soon as I can, but depending on how
- busy I am it may take me a couple of months.
+ This program is free software; you may redistribute it and/or modify it
+ under the same terms as Perl itself. Please see the section LICENSE
+ below for more information.
BLURB
- Term::ANSIColor provides constants and simple functions for sending ANSI
+ Term::ANSIColor provides constants and simple functions for setting ANSI
text attributes, most notably colors. It can be used to set the current
text attributes or to apply a set of attributes to a string and reset
- the current text attributes at the end of that string.
+ the current text attributes at the end of that string. Eight-color,
+ sixteen-color, and 256-color escape sequences are all supported.
DESCRIPTION
- This module grew out of a thread on comp.lang.perl.misc where several of
- us were throwing around different ways to print colored text from Perl
- scripts and Zenin posted his old library to do that. I (Russ) disagreed
- with the implementation and offered my own (the color() and colored()
- functions implemented in this package), Zenin convinced me that the
- constants had their place as well, and we started figuring out the best
- ways of implementing both.
-
- While ANSI color escape codes are fairly simple, it can be hard to
- remember the codes for all of the attributes and the code resulting from
- hard-coding them into your script is definitely difficult to read. This
- module is designed to fix those problems, as well as provide a
- convenient interface to do a few things for you automatically (like
- resetting attributes after the text you print out so that you don't
- accidentally leave attributes set).
-
- Despite its name, this module can also handle non-color ANSI text
- attributes (bold, underline, reverse video, and blink). It uses either
- of two interfaces, one of which uses "constants" for each different
- attribute and the other of which uses two subs which take strings of
- attributes as arguments.
+ This Perl module is a simple and convenient interface to the ANSI
+ terminal escape sequences for color (from ECMA-48, also included in ISO
+ 6429). The color sequences are provided in two forms, either as
+ constants for each color or via a function that takes the names of
+ colors and returns the appropriate escape codes or wraps them around the
+ provided text. The non-color text style codes from ANSI X3.64 (bold,
+ dark, underline, and reverse, for example), which were also included in
+ ECMA-48 and ISO 6429, are also supported. Also supported are the
+ extended colors used for sixteen-color and 256-color emulators.
+
+ This module is very stable, and I've used it in a wide variety of
+ applications. It has been included in the core Perl distribution
+ starting with version 5.6.0, so you don't need to download and install
+ it yourself unless you have an old version of Perl or need a newer
+ version of the module than comes with your version of Perl. I continue
+ to maintain it as a separate module, and the version included in Perl is
+ resynced with mine before each release.
+
+ The original module came out of a discussion in comp.lang.perl.misc and
+ is a combination of two approaches, one with constants by Zenin and one
+ with functions that I wrote. I offered to maintain a combined module
+ that included both approaches.
See the POD documentation for complete details, features, and usage.
- This module is distributed as part of the Perl core distribution as of
- Perl 5.6.0. You only need to install this module if you want a newer
- version than came with Perl or if you have an old version of Perl.
-
REQUIREMENTS
Term::ANSIColor is written in pure Perl and has no module dependencies
that aren't found in Perl core. It should work with any version of Perl
- after 5.001, although it hasn't been tested with old versions in some
+ after 5.6, although it hasn't been tested with old versions in some
time.
- The test suite requires the Test::More module. To check the POD
- documentation, Test::Pod is also required. To check spelling,
- Pod::Spell and either aspell or ispell with the american dictionary are
- also required. The user's path is searched for aspell or ispell and
- aspell is preferred. Spelling tests are disabled by default since
- spelling dictionaries differ too much between systems. To enable those
- tests, set RRA_MAINTAINER_TESTS to a true value.
+ In order to actually see color, you will need to use a terminal window
+ that supports the ANSI escape sequences for color. Any recent version
+ of xterm, most xterm derivatives and replacements, and most telnet and
+ ssh clients for Windows and Macintosh should work, as will the MacOS X
+ Terminal application (although Terminal.app reportedly doesn't support
+ 256 colors). The console windows for Windows NT and Windows 2000 will
+ not work, as they do not even attempt to support ANSI X3.64.
+
+ For a complete (to my current knowledge) compatibility list, see the
+ Term::ANSIColor module documentation. If you have any additions to the
+ table in the documentation, please send them to me.
+
+ The test suite requires Perl and Test::More (part of Perl since 5.6.2).
+ It also makes use of additional Perl modules for some tests. These
+ tests will be skipped automatically if the modules aren't available. To
+ run the full set of default tests, you will need the Perl modules:
+
+ Perl::Critic
+ Test::MinimumVersion
+ Test::Pod
+ Test::Pod::Coverage
+ Test::Strict
+ Test::Synopsis
+ Test::Warn
+
+ and their dependencies. These modules are all available from CPAN.
+
+ Some parts of the test suite are suppressed by default because those
+ tests are normally only useful for the maintainer. This includes tests
+ of POD spelling and Perl coding style. To enable those tests, set the
+ environment variable RRA_MAINTAINER_TESTS to a true value. For these
+ tests, the additional Perl modules:
+
+ Devel::Cover
+ Test::Perl::Critic
+ Test::Spelling
+
+ and their dependencies as well as a spell-checking program (several are
+ supported by Test::Spelling) are required. These modules are all
+ available from CPAN.
INSTALLATION
WARNING: Installation of this package will replace the Term::ANSIColor
- that came with Perl for Perl 5.6.0 or later. Term::ANSIColor that came
- with Perl. You may want to save a backup copy of the standard version
- first.
+ that came with Perl. You may want to save a backup copy of the standard
+ version first.
Follow the standard installation procedure for Perl modules, which is to
type the following commands:
install the module by hand, simply copy it into a directory named Term
in your Perl library directory.
-HOMEPAGE AND SOURCE REPOSITORY
+SUPPORT
The Term::ANSIColor web page at:
will always have the current version of this package, the current
documentation, and pointers to any additional resources.
+ For bug tracking, this package uses the CPAN bug tracker at:
+
+ https://rt.cpan.org/
+
+ Look for the Term-ANSIColor distribution.
+
+ I welcome bug reports and patches for this package at rra@stanford.edu
+ or via the CPAN bug tracker at <http://rt.cpan.org/>. However, please
+ be aware that I tend to be extremely busy and work projects often take
+ priority. I'll save your mail and get to it as soon as I can, but it
+ may take me a couple of months.
+
+SOURCE REPOSITORY
+
Term::ANSIColor is maintained using Git. You can access the current
source by cloning the repository at:
http://git.eyrie.org/?p=perl/ansicolor.git
- For bug tracking, this package uses the CPAN bug tracker at:
-
- https://rt.cpan.org/
-
- Look for the Term-ANSIColor distribution.
+ When contributing modifications, patches (possibly generated by
+ git-format-patch) are preferred to Git pull requests.
THANKS
To Daniel Lindsley for the information about what Mac OS X Terminal
supports.
- To Joe Smith for the test files that exercise a wide variety of VT100
- escape sequences including the ECMA-48 color control codes.
+ To Joe Smith for the original test files that exercise a wide variety of
+ VT100 escape sequences including the ECMA-48 color control codes. These
+ have been replaced by an example script, but they were very useful.
To James Bowlin for catching a bug in colored when $EACHLINE is set that
caused it to not color lines consisting solely of 0.
To Simon Wistow for reporting that Term::ANSIColor was inadvertantly
clobbering $@ when generating constant subs.
+ To Kurt Starsinic for the initial implementation of 256-color support.
+
+ To Magnus Woldrich for Term::ExtendedColor and for research on which
+ emulators support 256 colors.
+
+ To Stephen Thirlwall for the initial implementation of custom color
+ support.
+
+ To BlueT - Matthew Lien - 練喆明 for quick testing of 4.00 and reporting
+ a problem with skipping one of the tests.
+
To Larry Wall, as always, for Perl.
+
+LICENSE
+
+ The Term-ANSIColor distribution as a whole is covered by the following
+ copyright statement and license:
+
+ Copyright 1996 Zenin
+ Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009,
+ 2010, 2011, 2012 Russ Allbery <rra@stanford.edu>
+ Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
+
+ This program is free software; you may redistribute it and/or modify
+ it under the same terms as Perl itself. This means that you may
+ choose between the two licenses that Perl is released under: the GNU
+ GPL and the Artistic License. Please see your Perl distribution for
+ the details and copies of the licenses.
+
+ PUSH/POP support submitted 2007 by openmethods.com voice solutions
+
+ All individual files without an explicit exception below are released
+ under this license. Some files may have additional copyright holders as
+ noted in those files. There is detailed information about the licensing
+ of each file in the LICENSE file in this distribution.
+
+ Some files in this distribution are individually released under
+ different licenses, all of which are compatible with the above general
+ package license but which may require preservation of additional
+ notices. All required notices are preserved in the LICENSE file.
--- /dev/null
+#!/usr/bin/perl
+#
+# Test setting color aliases via the function interface.
+#
+# Copyright 2012 Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+use strict;
+use warnings;
+
+use Test::More tests => 23;
+
+# Load the module.
+BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
+ delete $ENV{ANSI_COLORS_DISABLED};
+ use_ok('Term::ANSIColor', qw(color colored colorvalid uncolor coloralias));
+}
+
+# Confirm our test alias doesn't exist.
+my $output = eval { color('alert') };
+ok(!$output, 'alert color not recognized');
+like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] alert [ ] at [ ] }xms,
+ '...with the right error'
+);
+
+# Basic alias functionality.
+is(coloralias('alert', 'red'), 'red', 'coloralias works and returns color');
+is(color('alert'), color('red'), 'alert now works as a color');
+is(colored('test', 'alert'), "\e[31mtest\e[0m", '..and colored works');
+ok(colorvalid('alert'), '...and alert is now a valid color');
+is(coloralias('alert'), 'red', 'coloralias with one arg returns value');
+
+# The alias can be changed.
+is(coloralias('alert', 'green'), 'green', 'changing the alias works');
+is(coloralias('alert'), 'green', '...and changed the mapping');
+is(color('alert'), color('green'), '...and now returns its new value');
+
+# uncolor ignores aliases.
+is_deeply([uncolor("\e[32m")], ['green'], 'uncolor ignores aliases');
+
+# Asking for the value of an unknown alias returns undef.
+is(coloralias('warning'), undef, 'coloralias on unknown alias returns undef');
+
+# Invalid alias names.
+$output = eval { coloralias('foo;bar', 'green') };
+ok(!$output, 'invalid alias name rejected');
+like(
+ $@,
+ qr{ \A Invalid [ ] alias [ ] name [ ] "foo;bar" [ ] at [ ] }xms,
+ '...with the right error'
+);
+$output = eval { coloralias(q{}, 'green') };
+ok(!$output, 'empty alias name rejected');
+like(
+ $@,
+ qr{ \A Invalid [ ] alias [ ] name [ ] "" [ ] at [ ] }xms,
+ '...with the right error'
+);
+
+# Aliasing an existing color.
+$output = eval { coloralias('red', 'green') };
+ok(!$output, 'aliasing an existing color rejected');
+like(
+ $@,
+ qr{ \A Cannot [ ] alias [ ] standard [ ] color [ ] "red" [ ] at [ ] }xms,
+ '...with the right error'
+);
+
+# Aliasing to a color that doesn't exist, or to another alias.
+$output = eval { coloralias('warning', 'chartreuse') };
+ok(!$output, 'aliasing to an unknown color rejected');
+like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] "chartreuse" [ ] at [ ] }xms,
+ '...with the right error'
+);
+$output = eval { coloralias('warning', 'alert') };
+ok(!$output, 'aliasing to an alias rejected');
+like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] "alert" [ ] at [ ] }xms,
+ '...with the right error'
+);
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl
#
-# t/basic.t -- Test suite for the Term::ANSIColor Perl module.
+# Basic test suite for the Term::ANSIColor Perl module.
#
# Copyright 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2009, 2010, 2012
# Russ Allbery <rra@stanford.edu>
# under the same terms as Perl itself.
use strict;
-use Test::More tests => 54;
+use warnings;
+use Test::More tests => 152;
+
+# Load the module.
BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
delete $ENV{ANSI_COLORS_DISABLED};
- use_ok ('Term::ANSIColor',
- qw/:pushpop color colored uncolor colorstrip colorvalid/);
+ use_ok('Term::ANSIColor',
+ qw(:pushpop color colored uncolor colorstrip colorvalid));
}
# Various basic tests.
-is (color ('blue on_green', 'bold'), "\e[34;42;1m", 'Simple attributes');
-is (colored ('testing', 'blue', 'bold'), "\e[34;1mtesting\e[0m", 'colored');
-is ((BLUE BOLD "testing"), "\e[34m\e[1mtesting", 'Constants');
+is(color('blue on_green', 'bold'), "\e[34;42;1m", 'Simple attributes');
+is(colored('testing', 'blue', 'bold'), "\e[34;1mtesting\e[0m", 'colored');
+is((BLUE BOLD 'testing'), "\e[34m\e[1mtesting", 'Constants');
+is(join(q{}, BLUE, BOLD, 'testing'),
+ "\e[34m\e[1mtesting", 'Constants with commas');
+is((BLUE 'test', 'ing'), "\e[34mtesting", 'Constants with multiple strings');
+
+# Test case variations on attributes.
+is(color('Blue BOLD', 'on_GReeN'), "\e[34;1;42m", 'Attribute case');
+
+# color should return undef if there were no attributes.
+is(color(), undef, 'color returns undef with no attributes');
+
+# Autoreset after the end of a command string.
$Term::ANSIColor::AUTORESET = 1;
-is ((BLUE BOLD "testing"), "\e[34m\e[1mtesting\e[0m\e[0m", 'AUTORESET');
+is((BLUE BOLD 'testing'), "\e[34m\e[1mtesting\e[0m\e[0m", 'AUTORESET');
+is((BLUE BOLD, 'te', 'st'), "\e[34m\e[1mtest\e[0m", 'AUTORESET with commas');
+$Term::ANSIColor::AUTORESET = 0;
+
+# Reset after each line terminator.
$Term::ANSIColor::EACHLINE = "\n";
-is (colored ("test\n\ntest", 'bold'), "\e[1mtest\e[0m\n\n\e[1mtest\e[0m",
- 'EACHLINE');
+is(colored("test\n\ntest", 'bold'),
+ "\e[1mtest\e[0m\n\n\e[1mtest\e[0m", 'EACHLINE');
$Term::ANSIColor::EACHLINE = "\r\n";
-is (colored ("test\ntest\r\r\n\r\n", 'bold'),
+is(
+ colored("test\ntest\r\r\n\r\n", 'bold'),
"\e[1mtest\ntest\r\e[0m\r\n\r\n",
- 'EACHLINE with multiple delimiters');
+ 'EACHLINE with multiple delimiters'
+);
$Term::ANSIColor::EACHLINE = "\n";
-is (colored (['bold', 'on_green'], "test\n", "\n", "test"),
+is(
+ colored(['bold', 'on_green'], "test\n", "\n", 'test'),
"\e[1;42mtest\e[0m\n\n\e[1;42mtest\e[0m",
- 'colored with reference to array');
-is_deeply ([ uncolor ('1;42', "\e[m", '', "\e[0m") ],
- [ qw/bold on_green clear/ ], 'uncolor');
+ 'colored with reference to array'
+);
+
+# Basic tests for uncolor.
+is_deeply([uncolor('1;42', "\e[m", q{}, "\e[0m")],
+ [qw(bold on_green clear)], 'uncolor');
+is_deeply([uncolor("\e[01m")], ['bold'], 'uncolor("\\e[01m")');
+is_deeply([uncolor("\e[m")], [], 'uncolor("\\e[m")');
+is_deeply([uncolor(q{})], [], 'uncolor("")');
# Several tests for ANSI_COLORS_DISABLED.
-$ENV{ANSI_COLORS_DISABLED} = 1;
-is (color ('blue'), '', 'color support for ANSI_COLORS_DISABLED');
-is (colored ('testing', 'blue', 'on_red'), 'testing',
- 'colored support for ANSI_COLORS_DISABLED');
-is ((GREEN 'testing'), 'testing', 'Constant support for ANSI_COLORS_DISABLED');
+local $ENV{ANSI_COLORS_DISABLED} = 1;
+is(color('blue'), q{}, 'color support for ANSI_COLORS_DISABLED');
+is(colored('testing', 'blue', 'on_red'),
+ 'testing', 'colored support for ANSI_COLORS_DISABLED');
+is((GREEN 'testing'), 'testing', 'Constant support for ANSI_COLORS_DISABLED');
+delete $ENV{ANSI_COLORS_DISABLED};
+
+# Earlier versions of Term::ANSIColor didn't support ANSI_COLORS_DISABLED if
+# the constant had been created before the environment variable was set. Test
+# all the ones we're going to use to get full test coverage.
+local $ENV{ANSI_COLORS_DISABLED} = 1;
+is((BLUE 'testing'), 'testing', 'ANSI_COLORS_DISABLED with existing constant');
+delete $ENV{ANSI_COLORS_DISABLED};
+
+# If ANSI_COLORS_DISABLED is set to a false value or the empty string, it
+# should not take effect.
+local $ENV{ANSI_COLORS_DISABLED} = 0;
+is(color('bold'), "\e[1m", 'ANSI_COLORS_DISABLED must be true');
+is((BOLD), "\e[1m", '...likewise for constants');
+local $ENV{ANSI_COLORS_DISABLED} = q{};
+is(color('bold'), "\e[1m", '...likewise when set to an empty string');
+is((BOLD), "\e[1m", '...likewise for constants');
delete $ENV{ANSI_COLORS_DISABLED};
# Make sure DARK is exported. This was omitted in versions prior to 1.07.
-is ((DARK "testing"), "\e[2mtesting\e[0m", 'DARK');
+is((DARK 'testing'), "\e[2mtesting", 'DARK');
# Check faint as a synonym for dark.
-is (colored ('test', 'faint'), "\e[2mtest\e[0m", 'colored supports faint');
-is ((FAINT "test"), "\e[2mtest\e[0m", '...and the FAINT constant works');
+is(colored('test', 'faint'), "\e[2mtest\e[0m", 'colored supports faint');
+is((FAINT 'test'), "\e[2mtest", '...and the FAINT constant works');
# Test bright color support.
-is (color ('bright_red'), "\e[91m", 'Bright red is supported');
-is ((BRIGHT_RED "test"), "\e[91mtest\e[0m", '...and as a constant');
-is (color ('on_bright_red'), "\e[101m", '...as is on bright red');
-is ((ON_BRIGHT_RED "test"), "\e[101mtest\e[0m", '...and as a constant');
+is(color('bright_red'), "\e[91m", 'Bright red is supported');
+is((BRIGHT_RED 'test'), "\e[91mtest", '...and as a constant');
+is(color('on_bright_red'), "\e[101m", '...as is on bright red');
+is((ON_BRIGHT_RED 'test'), "\e[101mtest", '...and as a constant');
# Test italic, which was added in 3.02.
-is (color ('italic'), "\e[3m", 'Italic is supported');
-is ((ITALIC 'test'), "\e[3mtest\e[0m", '...and as a constant');
+is(color('italic'), "\e[3m", 'Italic is supported');
+is((ITALIC 'test'), "\e[3mtest", '...and as a constant');
-# Test colored with 0 and EACHLINE.
+# Test colored with 0 and EACHLINE. Regression test for an incorrect use of a
+# truth check.
$Term::ANSIColor::EACHLINE = "\n";
-is (colored ('0', 'blue', 'bold'), "\e[34;1m0\e[0m",
- 'colored with 0 and EACHLINE');
-is (colored ("0\n0\n\n", 'blue', 'bold'), "\e[34;1m0\e[0m\n\e[34;1m0\e[0m\n\n",
- 'colored with 0, EACHLINE, and multiple lines');
+is(colored('0', 'blue', 'bold'),
+ "\e[34;1m0\e[0m", 'colored with 0 and EACHLINE');
+is(
+ colored("0\n0\n\n", 'blue', 'bold'),
+ "\e[34;1m0\e[0m\n\e[34;1m0\e[0m\n\n",
+ 'colored with 0, EACHLINE, and multiple lines'
+);
# Test colored with the empty string and EACHLINE.
-is (colored ('', 'blue', 'bold'), '',
- 'colored with an empty string and EACHLINE');
+is(colored(q{}, 'blue', 'bold'), q{}, 'colored w/empty string and EACHLINE');
# Test push and pop support.
-$Term::ANSIColor::AUTORESET = 0;
-is ((PUSHCOLOR RED ON_GREEN "text"), "\e[31m\e[42mtext",
- 'PUSHCOLOR does not break constants');
-is ((PUSHCOLOR BLUE "text"), "\e[34mtext", '...and adding another level');
-is ((RESET BLUE "text"), "\e[0m\e[34mtext", '...and using reset');
-is ((POPCOLOR "text"), "\e[31m\e[42mtext", '...and POPCOLOR works');
-is ((LOCALCOLOR GREEN ON_BLUE "text"), "\e[32m\e[44mtext\e[31m\e[42m",
- 'LOCALCOLOR');
+is((PUSHCOLOR RED ON_GREEN 'text'),
+ "\e[31m\e[42mtext", 'PUSHCOLOR does not break constants');
+is((PUSHCOLOR BLUE 'text'), "\e[34mtext", '...and adding another level');
+is((RESET BLUE 'text'), "\e[0m\e[34mtext", '...and using reset');
+is((POPCOLOR 'text'), "\e[31m\e[42mtext", '...and POPCOLOR works');
+is((LOCALCOLOR GREEN ON_BLUE 'text'),
+ "\e[32m\e[44mtext\e[31m\e[42m", 'LOCALCOLOR');
$Term::ANSIColor::AUTOLOCAL = 1;
-is ((ON_BLUE "text"), "\e[44mtext\e[31m\e[42m", 'AUTOLOCAL');
+is((BLUE 'text'), "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL');
+is((BLUE 'te', 'xt'), "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL with commas');
$Term::ANSIColor::AUTOLOCAL = 0;
-is ((POPCOLOR "text"), "\e[0mtext", 'POPCOLOR with empty stack');
+is((POPCOLOR 'text'), "\e[0mtext", 'POPCOLOR with empty stack');
+
+# If AUTOLOCAL and AUTORESET are both set, the former takes precedence.
+is((PUSHCOLOR RED ON_GREEN 'text'),
+ "\e[31m\e[42mtext", 'Push some colors onto the stack');
+$Term::ANSIColor::AUTOLOCAL = 1;
+$Term::ANSIColor::AUTORESET = 1;
+is((BLUE 'text'), "\e[34mtext\e[31m\e[42m", 'AUTOLOCAL overrides AUTORESET');
+$Term::ANSIColor::AUTOLOCAL = 0;
+is((BLUE 'text'), "\e[34mtext\e[0m", 'AUTORESET works with stacked colors');
+is((POPCOLOR 'text'), "\e[0mtext\e[0m", 'POPCOLOR with empty stack');
+$Term::ANSIColor::AUTORESET = 0;
# Test push and pop support with the syntax from the original openmethods.com
# submission, which uses a different coding style.
-is (PUSHCOLOR (RED ON_GREEN), "\e[31m\e[42m",
- 'PUSHCOLOR with explict argument');
-is (PUSHCOLOR (BLUE), "\e[34m", '...and another explicit argument');
-is (RESET . BLUE . "text", "\e[0m\e[34mtext",
- '...and constants with concatenation');
-is (POPCOLOR . "text", "\e[31m\e[42mtext",
- '...and POPCOLOR works without an argument');
-is (LOCALCOLOR(GREEN . ON_BLUE . "text"), "\e[32m\e[44mtext\e[31m\e[42m",
- 'LOCALCOLOR with two arguments');
-is (POPCOLOR . "text", "\e[0mtext", 'POPCOLOR with no arguments');
+is(PUSHCOLOR(RED ON_GREEN), "\e[31m\e[42m", 'PUSHCOLOR with explict argument');
+is(PUSHCOLOR(BLUE), "\e[34m", '...and another explicit argument');
+is(
+ RESET . BLUE . 'text',
+ "\e[0m\e[34mtext",
+ '...and constants with concatenation'
+);
+is(
+ POPCOLOR . 'text',
+ "\e[31m\e[42mtext",
+ '...and POPCOLOR works without an argument'
+);
+is(
+ LOCALCOLOR(GREEN . ON_BLUE . 'text'),
+ "\e[32m\e[44mtext\e[31m\e[42m",
+ 'LOCALCOLOR with two arguments'
+);
+is(POPCOLOR . 'text', "\e[0mtext", 'POPCOLOR with no arguments');
+
+# Prior to Term::ANSIColor, PUSHCOLOR, unlike all other constants, didn't take
+# an array, so it could lose colors in some syntax.
+is(PUSHCOLOR(RED, ON_GREEN), "\e[31m\e[42m", 'PUSHCOLOR with two arguments');
+is(
+ LOCALCOLOR(GREEN, 'text'),
+ "\e[32mtext\e[31m\e[42m",
+ 'LOCALCOLOR with two arguments'
+);
+is(POPCOLOR(BOLD, 'text'), "\e[0m\e[1mtext", 'POPCOLOR with two arguments');
# Test colorstrip.
-is (colorstrip ("\e[1mBold \e[31;42mon green\e[0m\e[m"), 'Bold on green',
- 'Basic color stripping');
-is (colorstrip ("\e[1m", 'bold', "\e[0m"), 'bold',
- 'Color stripping across multiple strings');
-is_deeply ([ colorstrip ("\e[1m", 'bold', "\e[0m") ],
- [ '', 'bold', '' ], '...and in an array context');
-is (colorstrip ("\e[2cSome other code\e and stray [0m stuff"),
+is(
+ colorstrip("\e[1mBold \e[31;42mon green\e[0m\e[m"),
+ 'Bold on green',
+ 'Basic color stripping'
+);
+is(colorstrip("\e[1m", 'bold', "\e[0m"),
+ 'bold', 'Color stripping across multiple strings');
+is_deeply(
+ [colorstrip("\e[1m", 'bold', "\e[0m")],
+ [q{}, 'bold', q{}],
+ '...and in an array context'
+);
+is(colorstrip("foo\e[1m", 'bar', "baz\e[0m"),
+ 'foobarbaz', '...and proper joining in scalar context');
+is(
+ colorstrip("\e[2cSome other code\e and stray [0m stuff"),
"\e[2cSome other code\e and stray [0m stuff",
- 'colorstrip does not remove non-color stuff');
+ 'colorstrip does not remove non-color stuff'
+);
# Test colorvalid.
-is (colorvalid ("blue bold dark", "blink on_green"), 1,
- 'colorvalid returns true for valid attributes');
-is (colorvalid ("green orange"), undef,
- '...and false for invalid attributes');
-
-# Test error handling.
-my $output = eval { color 'chartreuse' };
-is ($output, undef, 'color on unknown color name fails');
-like ($@, qr/^Invalid attribute name chartreuse at /,
- '...with the right error');
-$output = eval { colored "Stuff", 'chartreuse' };
-is ($output, undef, 'colored on unknown color name fails');
-like ($@, qr/^Invalid attribute name chartreuse at /,
- '...with the right error');
+ok(
+ colorvalid('blue bold dark', 'blink on_green'),
+ 'colorvalid returns true for valid attributes'
+);
+ok(!colorvalid('green orange'), '...and false for invalid attributes');
+
+# Test error handling in color.
+my $output = eval { color('chartreuse') };
+is($output, undef, 'color on unknown color name fails');
+like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] chartreuse [ ] at [ ] }xms,
+ '...with the right error'
+);
+
+# Test error handling in colored.
+$output = eval { colored('Stuff', 'chartreuse') };
+is($output, undef, 'colored on unknown color name fails');
+like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] chartreuse [ ] at [ ] }xms,
+ '...with the right error'
+);
+
+# Test error handling in uncolor.
$output = eval { uncolor "\e[28m" };
-is ($output, undef, 'uncolor on unknown color code fails');
-like ($@, qr/^No name for escape sequence 28 at /, '...with the right error');
+is($output, undef, 'uncolor on unknown color code fails');
+like(
+ $@,
+ qr{ \A No [ ] name [ ] for [ ] escape [ ] sequence [ ] 28 [ ] at [ ] }xms,
+ '...with the right error'
+);
$output = eval { uncolor "\e[foom" };
-is ($output, undef, 'uncolor on bad escape sequence fails');
-like ($@, qr/^Bad escape sequence foo at /, '...with the right error');
+is($output, undef, 'uncolor on bad escape sequence fails');
+like(
+ $@,
+ qr{ \A Bad [ ] escape [ ] sequence [ ] foo [ ] at [ ] }xms,
+ '...with the right error'
+);
# Test error reporting when calling unrecognized Term::ANSIColor subs that go
# through AUTOLOAD.
-eval { Term::ANSIColor::RSET () };
-like ($@, qr/^undefined subroutine \&Term::ANSIColor::RSET called at /,
- 'Correct error from an attribute that is not defined');
-eval { Term::ANSIColor::reset () };
-like ($@, qr/^undefined subroutine \&Term::ANSIColor::reset called at /,
- 'Correct error from a lowercase attribute');
+## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
+ok(!eval { Term::ANSIColor::RSET() }, 'Running invalid constant');
+like(
+ $@,
+ qr{ \A undefined [ ] subroutine [ ] \&Term::ANSIColor::RSET [ ] called
+ [ ] at [ ] }xms,
+ 'Correct error from an attribute that is not defined'
+);
+ok(!eval { Term::ANSIColor::reset() }, 'Running invalid sub');
+like(
+ $@,
+ qr{ \A undefined [ ] subroutine [ ] \&Term::ANSIColor::reset [ ] called
+ [ ] at [ ] }xms,
+ 'Correct error from a lowercase attribute'
+);
# Ensure that we still get proper error reporting for unknown constants when
# when colors are disabled.
-$ENV{ANSI_COLORS_DISABLED} = 1;
-eval { Term::ANSIColor::RSET () };
-like ($@, qr/^undefined subroutine \&Term::ANSIColor::RSET called at /,
- 'Correct error from undefined attribute with disabled colors');
+local $ENV{ANSI_COLORS_DISABLED} = 1;
+eval { Term::ANSIColor::RSET() };
+like(
+ $@,
+ qr{ \A undefined [ ] subroutine [ ] \&Term::ANSIColor::RSET [ ] called
+ [ ] at [ ] }xms,
+ 'Correct error from undefined attribute with disabled colors'
+);
+delete $ENV{ANSI_COLORS_DISABLED};
+
+# These are somewhat redundant, but they ensure we test all the branches in
+# our generated constant subs so that we can use Test::Strict to check test
+# suite coverage.
+is((BOLD 't'), "\e[1mt", 'Basic constant works for BOLD');
+is((BLUE 't'), "\e[34mt", '...and for BLUE');
+is((GREEN 't'), "\e[32mt", '...and for GREEN');
+is((DARK 't'), "\e[2mt", '...and for DARK');
+is((FAINT 't'), "\e[2mt", '...and for FAINT');
+is((BRIGHT_RED 't'), "\e[91mt", '...and for BRIGHT_RED');
+is((ON_BRIGHT_RED 't'), "\e[101mt", '...and for ON_BRIGHT_RED');
+is((ITALIC 't'), "\e[3mt", '...and for ITALIC');
+is((RED 't'), "\e[31mt", '...and for RED');
+is((ON_GREEN 't'), "\e[42mt", '...and for ON_GREEN');
+is((ON_BLUE 't'), "\e[44mt", '...and for ON_BLUE');
+is((RESET 't'), "\e[0mt", '...and for RESET');
+
+# Do the same for disabled colors.
+local $ENV{ANSI_COLORS_DISABLED} = 1;
+is(BOLD, q{}, 'ANSI_COLORS_DISABLED works for BOLD');
+is(BLUE, q{}, '...and for BLUE');
+is(GREEN, q{}, '...and for GREEN');
+is(DARK, q{}, '...and for DARK');
+is(FAINT, q{}, '...and for FAINT');
+is(BRIGHT_RED, q{}, '...and for BRIGHT_RED');
+is(ON_BRIGHT_RED, q{}, '...and for ON_BRIGHT_RED');
+is(ITALIC, q{}, '...and for ITALIC');
+is(RED, q{}, '...and for RED');
+is(ON_GREEN, q{}, '...and for ON_GREEN');
+is(ON_BLUE, q{}, '...and for ON_BLUE');
+is(RESET, q{}, '...and for RESET');
delete $ENV{ANSI_COLORS_DISABLED};
+
+# Do the same for AUTORESET.
+$Term::ANSIColor::AUTORESET = 1;
+is((BOLD 't'), "\e[1mt\e[0m", 'AUTORESET works for BOLD');
+is((BLUE 't'), "\e[34mt\e[0m", '...and for BLUE');
+is((GREEN 't'), "\e[32mt\e[0m", '...and for GREEN');
+is((DARK 't'), "\e[2mt\e[0m", '...and for DARK');
+is((FAINT 't'), "\e[2mt\e[0m", '...and for FAINT');
+is((BRIGHT_RED 't'), "\e[91mt\e[0m", '...and for BRIGHT_RED');
+is((ON_BRIGHT_RED 't'), "\e[101mt\e[0m", '...and for ON_BRIGHT_RED');
+is((ITALIC 't'), "\e[3mt\e[0m", '...and for ITALIC');
+is((RED 't'), "\e[31mt\e[0m", '...and for RED');
+is((ON_GREEN 't'), "\e[42mt\e[0m", '...and for ON_GREEN');
+is((ON_BLUE 't'), "\e[44mt\e[0m", '...and for ON_BLUE');
+is((RESET 't'), "\e[0mt\e[0m", '...and for RESET');
+is((BOLD), "\e[1m", 'AUTORESET without text for BOLD');
+is((BLUE), "\e[34m", '...and for BLUE');
+is((GREEN), "\e[32m", '...and for GREEN');
+is((DARK), "\e[2m", '...and for DARK');
+is((FAINT), "\e[2m", '...and for FAINT');
+is((BRIGHT_RED), "\e[91m", '...and for BRIGHT_RED');
+is((ON_BRIGHT_RED), "\e[101m", '...and for ON_BRIGHT_RED');
+is((ITALIC), "\e[3m", '...and for ITALIC');
+is((RED), "\e[31m", '...and for RED');
+is((ON_GREEN), "\e[42m", '...and for ON_GREEN');
+is((ON_BLUE), "\e[44m", '...and for ON_BLUE');
+is((RESET), "\e[0m", '...and for RESET');
+$Term::ANSIColor::AUTORESET = 0;
+
+# Do the same for AUTOLOCAL.
+$Term::ANSIColor::AUTOLOCAL = 1;
+is((BOLD 't'), "\e[1mt\e[0m", 'AUTOLOCAL works for BOLD');
+is((BLUE 't'), "\e[34mt\e[0m", '...and for BLUE');
+is((GREEN 't'), "\e[32mt\e[0m", '...and for GREEN');
+is((DARK 't'), "\e[2mt\e[0m", '...and for DARK');
+is((FAINT 't'), "\e[2mt\e[0m", '...and for FAINT');
+is((BRIGHT_RED 't'), "\e[91mt\e[0m", '...and for BRIGHT_RED');
+is((ON_BRIGHT_RED 't'), "\e[101mt\e[0m", '...and for ON_BRIGHT_RED');
+is((ITALIC 't'), "\e[3mt\e[0m", '...and for ITALIC');
+is((RED 't'), "\e[31mt\e[0m", '...and for RED');
+is((ON_GREEN 't'), "\e[42mt\e[0m", '...and for ON_GREEN');
+is((ON_BLUE 't'), "\e[44mt\e[0m", '...and for ON_BLUE');
+is((RESET 't'), "\e[0mt\e[0m", '...and for RESET');
+is((BOLD), "\e[1m", 'AUTOLOCAL without text for BOLD');
+is((BLUE), "\e[34m", '...and for BLUE');
+is((GREEN), "\e[32m", '...and for GREEN');
+is((DARK), "\e[2m", '...and for DARK');
+is((FAINT), "\e[2m", '...and for FAINT');
+is((BRIGHT_RED), "\e[91m", '...and for BRIGHT_RED');
+is((ON_BRIGHT_RED), "\e[101m", '...and for ON_BRIGHT_RED');
+is((ITALIC), "\e[3m", '...and for ITALIC');
+is((RED), "\e[31m", '...and for RED');
+is((ON_GREEN), "\e[42m", '...and for ON_GREEN');
+is((ON_BLUE), "\e[44m", '...and for ON_BLUE');
+is((RESET), "\e[0m", '...and for RESET');
+$Term::ANSIColor::AUTOLOCAL = 0;
+
+# Force an internal error inside the AUTOLOAD stub by creating an attribute
+# that will generate a syntax error. This is just for coverage purposes.
+# Disable warnings since our syntax error will spew otherwise.
+local $SIG{__WARN__} = sub { };
+$Term::ANSIColor::ATTRIBUTES{yellow} = q{'ERROR'};
+ok(!eval { YELLOW 't' }, 'Caught internal AUTOLOAD error');
+like(
+ $@,
+ qr{ \A failed [ ] to [ ] generate [ ] constant [ ] YELLOW: [ ] }xms,
+ '...with correct error message'
+);
--- /dev/null
+#!/usr/bin/perl
+#
+# Tests for 256-color support.
+#
+# Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
+# Copyright 2012 Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+use strict;
+use warnings;
+
+use Test::More tests => 92;
+
+# Load the module.
+BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
+ delete $ENV{ANSI_COLORS_DISABLED};
+ use_ok('Term::ANSIColor', qw(color uncolor colorvalid :constants256));
+}
+
+# Test basic 256-color codes.
+is(color('ansi0'), "\e[38;5;0m", 'ANSI 0');
+is(color('ansi15'), "\e[38;5;15m", 'ANSI 15');
+is(color('rgb000'), "\e[38;5;16m", 'RGB 000');
+is(color('rgb555'), "\e[38;5;231m", 'RGB 555');
+is(color('grey0'), "\e[38;5;232m", 'Grey 0');
+is(color('grey23'), "\e[38;5;255m", 'Grey 23');
+
+# Errors at boundary cases.
+for my $color (qw(ansi16 rgb600 rgb060 rgb006 rgb666 rgb999 rgb0000 grey24)) {
+ my $output = eval { color($color) };
+ is($output, undef, 'color on unknown color name fails');
+ like(
+ $@,
+ qr{ \A Invalid [ ] attribute [ ] name [ ] \Q$color\E [ ] at [ ] }xms,
+ '...with the right error'
+ );
+ ok(!colorvalid($color), '...and colorvalid says it is invalid');
+}
+
+# Check that various 256-color codes are valid.
+for my $color (qw(ansi0 ansi15 rgb000 rgb555 grey0 grey23)) {
+ ok(colorvalid($color), "Color $color is valid");
+}
+
+# Check uncolor with 256-color codes.
+is_deeply([uncolor('38;5;0')], ['ansi0'], 'uncolor of ansi0');
+is_deeply([uncolor("\e[38;5;231m")], ['rgb555'], 'uncolor of rgb555');
+is_deeply([uncolor("\e[48;05;001m")], ['on_ansi1'], 'uncolor with leading 0s');
+
+# An invalid 256-color code should report an error on the part that makes it
+# invalid. Check truncated codes (should report on the 38 or 48), codes with
+# an invalid second part (likewise), and codes with an invalid third part
+# (should report the complete code).
+#
+# This is a hash of test escape sequences to the invalid sequence that should
+# be reported.
+my %uncolor_tests = (
+ "\e[38m" => 38,
+ "\e[38;5m" => 38,
+ "\e[38;5;256m" => '38;5;256',
+ "\e[38;5;777m" => '38;5;777',
+ "\e[48m" => 48,
+ "\e[48;5m" => 48,
+ "\e[48;5;256m" => '48;5;256',
+ "\e[48;5;777m" => '48;5;777',
+);
+while (my ($escape, $invalid) = each %uncolor_tests) {
+ my $output = eval { uncolor($escape) };
+ is($output, undef, "uncolor on unknown color code \Q$escape\E fails");
+ like(
+ $@,
+ qr{ \A No [ ] name [ ] for [ ] escape [ ] sequence [ ] \Q$invalid\E
+ [ ] at [ ] }xms,
+ '...with the right error'
+ );
+}
+
+# Test all the variations of a few different constants.
+is((ANSI0 't'), "\e[38;5;0mt", 'Basic constant works for ANSI0');
+is((ANSI15 't'), "\e[38;5;15mt", '...and for ANSI15');
+is((RGB000 't'), "\e[38;5;16mt", '...and for RGB000');
+is((RGB555 't'), "\e[38;5;231mt", '...and for RGB555');
+is((GREY0 't'), "\e[38;5;232mt", '...and for GREY0');
+is((GREY23 't'), "\e[38;5;255mt", '...and for GREY23');
+
+# Do the same for disabled colors.
+local $ENV{ANSI_COLORS_DISABLED} = 1;
+is(ANSI0, q{}, 'ANSI_COLORS_DISABLED works for ANSI0');
+is(ANSI15, q{}, '...and for ANSI15');
+is(RGB000, q{}, '...and for RGB000');
+is(RGB555, q{}, '...and for RGB555');
+is(GREY0, q{}, '...and for GREY0');
+is(GREY23, q{}, '...and for GREY23');
+delete $ENV{ANSI_COLORS_DISABLED};
+
+# Do the same for AUTORESET.
+$Term::ANSIColor::AUTORESET = 1;
+is((ANSI0 't'), "\e[38;5;0mt\e[0m", 'AUTORESET works for ANSI0');
+is((ANSI15 't'), "\e[38;5;15mt\e[0m", '...and for ANSI15');
+is((RGB000 't'), "\e[38;5;16mt\e[0m", '...and for RGB000');
+is((RGB555 't'), "\e[38;5;231mt\e[0m", '...and for RGB555');
+is((GREY0 't'), "\e[38;5;232mt\e[0m", '...and for GREY0');
+is((GREY23 't'), "\e[38;5;255mt\e[0m", '...and for GREY23');
+is((ANSI0), "\e[38;5;0m", 'AUTORESET without text for ANSI0');
+is((ANSI15), "\e[38;5;15m", '...and for ANSI15');
+is((RGB000), "\e[38;5;16m", '...and for RGB000');
+is((RGB555), "\e[38;5;231m", '...and for RGB555');
+is((GREY0), "\e[38;5;232m", '...and for GREY0');
+is((GREY23), "\e[38;5;255m", '...and for GREY23');
+$Term::ANSIColor::AUTORESET = 0;
+
+# Do the same for AUTOLOCAL.
+$Term::ANSIColor::AUTOLOCAL = 1;
+is((ANSI0 't'), "\e[38;5;0mt\e[0m", 'AUTOLOCAL works for ANSI0');
+is((ANSI15 't'), "\e[38;5;15mt\e[0m", '...and for ANSI15');
+is((RGB000 't'), "\e[38;5;16mt\e[0m", '...and for RGB000');
+is((RGB555 't'), "\e[38;5;231mt\e[0m", '...and for RGB555');
+is((GREY0 't'), "\e[38;5;232mt\e[0m", '...and for GREY0');
+is((GREY23 't'), "\e[38;5;255mt\e[0m", '...and for GREY23');
+is((ANSI0), "\e[38;5;0m", 'AUTOLOCAL without text for ANSI0');
+is((ANSI15), "\e[38;5;15m", '...and for ANSI15');
+is((RGB000), "\e[38;5;16m", '...and for RGB000');
+is((RGB555), "\e[38;5;231m", '...and for RGB555');
+is((GREY0), "\e[38;5;232m", '...and for GREY0');
+is((GREY23), "\e[38;5;255m", '...and for GREY23');
+$Term::ANSIColor::AUTOLOCAL = 0;
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl
#
-# t/eval.t -- Test suite for $@ preservation with constants.
+# Test suite for $@ preservation with constants.
+#
+# Earlier versions of Term::ANSIColor would clobber $@ during AUTOLOAD
+# processing and lose its value or leak $@ values to the calling program.
+# This is a regression test to ensure that this problem doesn't return.
#
# Copyright 2012 Russ Allbery <rra@stanford.edu>
#
# under the same terms as Perl itself.
use strict;
+use warnings;
+
use Test::More tests => 5;
+# We refer to $@ in the test descriptions.
+## no critic (ValuesAndExpressions::RequireInterpolationOfMetachars)
+
+# Load the module.
BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
delete $ENV{ANSI_COLORS_DISABLED};
- use_ok ('Term::ANSIColor', qw/:constants/);
+ use_ok('Term::ANSIColor', qw/:constants/);
}
# Ensure that using a constant doesn't leak anything in $@.
-is ((BOLD 'test'), "\e[1mtest", 'BOLD works');
-is ($@, '', '... and $@ is empty');
+is((BOLD 'test'), "\e[1mtest", 'BOLD works');
+is($@, q{}, '... and $@ is empty');
# Store something in $@ and ensure it doesn't get clobbered.
+## no critic (BuiltinFunctions::ProhibitStringyEval)
+## no critic (ErrorHandling::RequireCheckingReturnValueOfEval)
eval 'sub { syntax';
-is ((BLINK 'test'), "\e[5mtest", 'BLINK works after eval failure');
-isnt ($@, '', '... and $@ still contains something useful');
+is((BLINK 'test'), "\e[5mtest", 'BLINK works after eval failure');
+isnt($@, q{}, '... and $@ still contains something useful');
-#!/usr/bin/perl -Tw
+#!/usr/bin/perl
#
-# t/stringify.t -- Test suite for stringify interaction.
+# Test suite for stringify interaction.
#
# Copyright 2011 Revilo Reegiles
# Copyright 2011 Russ Allbery <rra@stanford.edu>
# This program is free software; you may redistribute it and/or modify it
# under the same terms as Perl itself.
+use strict;
+use warnings;
+
+use Test::More tests => 6;
+
# Create a dummy class that implements stringification.
+## no critic (Modules::ProhibitMultiplePackages)
package Test::Stringify;
use overload '""' => 'stringify';
-sub new { return bless {} }
+sub new { return bless {}, 'Test::Stringify' }
sub stringify { return "Foo Bar\n" }
-package main;
-use strict;
-use Test::More tests => 6;
+# Back to the main package.
+package main;
+# Load the module.
BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
delete $ENV{ANSI_COLORS_DISABLED};
- use_ok ('Term::ANSIColor',
- qw/:pushpop color colored uncolor colorstrip colorvalid/);
+ use_ok('Term::ANSIColor', qw(colored));
}
-is (colored ([ 'blue', 'bold' ], 'testing'), "\e[34;1mtesting\e[0m",
- 'colored with an array reference');
-is (colored ("ok\n", 'bold blue'), "\e[1;34mok\n\e[0m",
- 'colored with a following string');
+# Some basic tests of colored without stringification.
+my $result = colored(['blue', 'bold'], 'testing');
+is($result, "\e[34;1mtesting\e[0m", 'colored with an array reference');
+$result = colored("ok\n", 'bold blue');
+is($result, "\e[1;34mok\n\e[0m", 'colored with a following string');
+
+# Create a stringifiable object and repeat the tests.
my $test = Test::Stringify->new;
-is (colored ($test . "", 'bold blue'), "\e[1;34mFoo Bar\n\e[0m",
- 'colored with forced stringification');
-is (colored ($test, 'bold blue'), "\e[1;34mFoo Bar\n\e[0m",
- 'colored with a non-array reference');
+$result = colored($test . q{}, 'bold blue');
+is($result, "\e[1;34mFoo Bar\n\e[0m", 'colored with forced stringification');
+$result = colored($test, 'bold blue');
+is($result, "\e[1;34mFoo Bar\n\e[0m", 'colored with a non-array reference');
+
+# Create a hash reference and try stringifying it.
my %foo = (foo => 'bar');
-like (colored (\%foo, 'bold blue'), qr/\e\[1;34mHASH\(.*\)\e\[0m/,
- 'colored with a hash reference');
+$result = colored(\%foo, 'bold blue');
+like(
+ $result,
+ qr{ \e\[1;34m HASH\(.*\) \e\[0m }xms,
+ 'colored with a hash reference'
+);
--- /dev/null
+#!/usr/bin/perl -T
+#
+# Check that Term::ANSIColor untaints generated constants.
+#
+# It's possible that the name of the constant function that we're calling
+# could be tained (such as by loading the name of the constant function from
+# an environment variable). Term::ANSIColor does the work to untaint it; be
+# sure that the taint flag is properly cleared.
+#
+# Copyright 2012 Russ Allbery <rra@stanford.edu>
+#
+# This program is free software; you may redistribute it and/or modify it
+# under the same terms as Perl itself.
+
+use strict;
+use warnings;
+
+use Test::More tests => 4;
+
+# Load the module.
+BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
+ delete $ENV{ANSI_COLORS_DISABLED};
+ use_ok('Term::ANSIColor', qw(:pushpop));
+}
+
+# Generate a tainted constant name. PATH is always tainted, and tainting is
+# sticky, so we can prepend the name to whatever PATH holds and then chop it
+# off again.
+my $constant = substr 'BOLD' . $ENV{PATH}, 0, length 'BOLD';
+
+# Using that as a constant should now work without any tainting problems.
+## no critic (TestingAndDebugging::ProhibitNoStrict)
+{
+ no strict 'refs';
+ is(&{$constant}(), "\e[1m", 'Constant subs are not tainted');
+ is(BOLD(), "\e[1m", '...and we can call the sub again');
+ ok(defined(&Term::ANSIColor::BOLD), '...and it is now defined');
+}
projects / platform / upstream / perl.git / commitdiff