# Color screen output using ANSI escape sequences.
#
-# Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
-# 2011, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
-# Copyright 1996 Zenin
-# Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
+# This module provides utility functions (in two different forms) for coloring
+# output with ANSI escape sequences.
#
-# 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
+# This module is sometimes used in low-memory environments, so avoid use of
+# \d, \w, [:upper:], and similar constructs in the most important functions
+# (color, colored, AUTOLOAD, and the generated constant functions) since
+# loading the Unicode attribute files consumes a lot of memory.
#
# Ah, September, when the sysadmins turn colors and fall off the trees....
# -- Dave Van Domelen
+#
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
##############################################################################
# Modules and declarations
package Term::ANSIColor;
-use 5.006;
+use 5.008;
use strict;
use warnings;
# Also uses Carp but loads it on demand to reduce memory usage.
-use Exporter ();
+use Exporter;
-# use Exporter plus @ISA instead of use base for 5.6 compatibility.
+# use Exporter plus @ISA instead of use base to reduce memory usage.
## no critic (ClassHierarchies::ProhibitExplicitISA)
# Declare variables that should be set in BEGIN for robustness.
# against circular module loading (not that we load any modules, but
# consistency is good).
BEGIN {
- $VERSION = '4.06';
+ $VERSION = '5.00';
# All of the basic supported constants, used in %EXPORT_TAGS.
my @colorlist = qw(
# Reverse lookup. Alphabetically first name for a sequence is preferred.
our %ATTRIBUTES_R;
-for my $attr (reverse sort keys %ATTRIBUTES) {
+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}) {
+if (exists($ENV{ANSI_COLORS_ALIASES})) {
my $spec = $ENV{ANSI_COLORS_ALIASES};
- $spec =~ s{\s+}{}xmsg;
+ $spec =~ s{ \A \s+ }{}xms;
+ $spec =~ s{ \s+ \z }{}xms;
# 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;
+ for my $definition (split(m{\s*,\s*}xms, $spec)) {
+ my ($new, $old) = split(m{\s*=\s*}xms, $definition, 2);
if (!$new || !$old) {
warn qq{Bad color mapping "$definition"};
} else {
$@ = $eval_err;
# Dispatch to the newly-created sub.
- ## no critic (References::ProhibitDoubleSigils)
goto &$AUTOLOAD;
}
## use critic
# Throws: Text exception for any invalid attribute
sub color {
my (@codes) = @_;
- @codes = map { split } @codes;
# Return the empty string if colors are disabled.
if ($ENV{ANSI_COLORS_DISABLED}) {
return q{};
}
+ # Split on whitespace and expand aliases.
+ @codes = map { split } @codes;
+ @codes = map { defined($ALIASES{$_}) ? @{ $ALIASES{$_} } : $_ } @codes;
+
# Build the attribute string from semicolon-separated numbers.
+ ## no critic (RegularExpressions::ProhibitEnumeratedClasses)
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{;};
+ } elsif ($code =~ m{ \A (on_)? r([0-9]+) g([0-9]+) b([0-9]+) \z }xms) {
+ my ($r, $g, $b) = ($2 + 0, $3 + 0, $4 + 0);
+ if ($r > 255 || $g > 255 || $b > 255) {
+ croak("Invalid attribute name $code");
+ }
+ my $prefix = $1 ? '48' : '38';
+ $attribute .= "$prefix;2;$r;$g;$b;";
} else {
croak("Invalid attribute name $code");
}
}
+ ## use critic
# We added one too many semicolons for simplicity. Remove the last one.
chop($attribute);
croak("Bad escape sequence $escape");
}
- # 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);
+ # Pull off 256-color codes (38;5;n or 48;5;n) and true color codes
+ # (38;2;n;n;n or 48;2;n;n;n) as a unit.
+ my $regex = qr{
+ (
+ 0*[34]8 ; 0*2 ; \d+ ; \d+ ; \d+
+ | 0*[34]8 ; 0*5 ; \d+
+ | \d+
+ )
+ (?: ; | \z )
+ }xms;
+ push(@nums, $attrs =~ m{$regex}xmsg);
}
# 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)) {
- croak("No name for escape sequence $num");
+ if ($num =~ m{ \A 0*([34])8 ; 0*2 ; (\d+) ; (\d+) ; (\d+) \z }xms) {
+ my ($r, $g, $b) = ($2 + 0, $3 + 0, $4 + 0);
+ if ($r > 255 || $g > 255 || $b > 255) {
+ croak("No name for escape sequence $num");
+ }
+ my $prefix = ($1 == 4) ? 'on_' : q{};
+ push(@result, "${prefix}r${r}g${g}b${b}");
+ } else {
+ $num =~ s{ ( \A | ; ) 0+ (\d) }{$1$2}xmsg;
+ my $name = $ATTRIBUTES_R{$num};
+ if (!defined($name)) {
+ croak("No name for escape sequence $num");
+ }
+ push(@result, $name);
}
- push(@result, $name);
}
# Return the attribute names.
my ($first, @rest) = @_;
my ($string, @codes);
if (ref($first) && ref($first) eq 'ARRAY') {
- @codes = @{$first};
+ @codes = @{$first};
$string = join(q{}, @rest);
} else {
$string = $first;
# 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)
+# @color - The color attributes the alias will correspond to (optional)
#
-# Returns: The standard color value of the alias
+# Returns: The standard color value of the alias as a string (may be multiple
+# attributes separated by spaces)
# 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;
+ my ($alias, @color) = @_;
+ if (!@color) {
+ if (exists($ALIASES{$alias})) {
+ return join(q{ }, @{ $ALIASES{$alias} });
} else {
- return $ATTRIBUTES_R{ $ALIASES{$alias} };
+ return;
}
}
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"});
}
## use critic
+ # Split on whitespace and expand aliases.
+ @color = map { split } @color;
+ @color = map { defined($ALIASES{$_}) ? @{ $ALIASES{$_} } : $_ } @color;
+
+ # Check that all of the attributes are valid.
+ for my $attribute (@color) {
+ if (!exists($ATTRIBUTES{$attribute})) {
+ croak(qq{Invalid attribute name "$attribute"});
+ }
+ }
+
# Set the alias and return.
- $ALIASES{$alias} = $ATTRIBUTES{$color};
- return $color;
+ $ALIASES{$alias} = [@color];
+ return join(q{ }, @color);
}
# Given a string, strip the ANSI color codes out of that string and return the
my (@codes) = @_;
@codes = map { split(q{ }, lc) } @codes;
for my $code (@codes) {
- if (!(defined($ATTRIBUTES{$code}) || defined($ALIASES{$code}))) {
- return;
+ next if defined($ATTRIBUTES{$code});
+ next if defined($ALIASES{$code});
+ if ($code =~ m{ \A (?: on_ )? r (\d+) g (\d+) b (\d+) \z }xms) {
+ next if ($1 <= 255 && $2 <= 255 && $3 <= 255);
}
+ return;
}
return 1;
}
Zenin reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com
openmethods.com. grey ATTR urxvt mistyped prepending Bareword filehandle
Cygwin Starsinic aterm rxvt CPAN RGB Solarized Whitespace alphanumerics
-undef
+undef CLICOLOR NNN GGG RRR
=head1 SYNOPSIS
colorstrip(), colorvalid(), and coloralias(), which have to be explicitly
imported to be used (see L</SYNOPSIS>).
+If you are using Term::ANSIColor in a console command, consider supporting the
+CLICOLOR standard. See L</"Supporting CLICOLOR"> for more information.
+
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 three types: ones that
-support only eight colors, ones that support sixteen, and ones that
-support 256. This module provides the ANSI escape codes for 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).
+Terminal emulators that support color divide into four types: ones that
+support only eight colors, ones that support sixteen, ones that support 256,
+and ones that support 24-bit color. This module provides the ANSI escape
+codes for all of them. These colors are referred to as ANSI colors 0 through
+7 (normal), 8 through 15 (16-color), 16 through 255 (256-color), and true
+color (called direct-color by B<xterm>).
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.
+There is unfortunately no way to know whether the current emulator
+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
+emulators in UNIX X environments. If you know the display is one of those
+emulators, you may wish to use the bright variants instead. Even better,
+offer the user a way to configure the colors for a given application to
+fit their terminal emulator.
+
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>
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 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
-emulators in UNIX X environments. If you know the display is one of those
-emulators, you may wish to use the bright variants instead. Even better,
-offer the user a way to configure the colors for a given application to
-fit their terminal emulator.
+For true color emulators, this module supports attributes of the form C<<
+rI<NNN>gI<NNN>bI<NNN> >> and C<< on_rI<NNN>gI<NNN>bI<NNN> >> for all values of
+I<NNN> between 0 and 255. These represent foreground and background colors,
+respectively, with the RGB values given by the I<NNN> numbers. These colors
+may be ignored completely on non-true-color terminals or may be misinterpreted
+and produce random behavior.
=head2 Function Interface
plus C<on_rgbI<RGB>> for I<R>, I<G>, and I<B> values from 0 to 5.
+For true color terminals, the recognized foreground colors are C<<
+rI<RRR>gI<GGG>bI<BBB> >> for I<RRR>, I<GGG>, and I<BBB> values between 0 and
+255. Similarly, the recognized background colors are C<<
+on_rI<RRR>gI<GGG>bI<BBB> >> for I<RRR>, I<GGG>, and I<BBB> values between 0
+and 255.
+
For any of the above listed attributes, case is not significant.
Attributes, once set, last until they are unset (by printing the attribute
be confused by attributes that span lines. Normally you'll want to set
$Term::ANSIColor::EACHLINE to C<"\n"> to use this feature.
+Particularly consider setting $Term::ANSIColor::EACHLINE if you are
+interleaving output to standard output and standard error and you aren't
+flushing standard output (via autoflush() or setting C<$|>). If you don't,
+the code to reset the color may unexpectedly sit in the standard output buffer
+rather than going to the display, causing standard error output to appear in
+the wrong color.
+
=item uncolor(ESCAPE)
uncolor() performs the opposite translation as color(), turning escape
colorvalid() takes attribute strings the same as color() and returns true
if all attributes are known and false otherwise.
-=item coloralias(ALIAS[, ATTR])
+=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 ASCII alphanumerics, C<.>, C<_>, and
-C<-> are allowed in alias names.
+If ATTR is specified, it is interpreted as a list of space-separated strings
+naming attributes or existing aliases. In this case, coloralias() sets up an
+alias of ALIAS for the set of attributes given by ATTR. From that point
+forward, ALIAS can be passed into color(), colored(), and colorvalid() and
+will have the same meaning as the sequence of attributes given in ATTR. One
+possible use of this facility is to give more meaningful names to the
+256-color RGB colors. Only ASCII 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.
+If ATTR is not specified, coloralias() returns the standard attribute or
+attributes to which ALIAS is aliased, if any, or undef if ALIAS does not
+exist. If it is aliased to multiple attributes, the return value will be a
+single string and the attributes will be separated by spaces.
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
use Term::ANSIColor 4.00 qw(RESET :constants256);
+True color and aliases are not supported by the constant interface.
+
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
$Term::ANSIColor::AUTORESET to a true value. Then, the display mode will
The subroutine interface has the advantage over the constants interface in
that only two subroutines are exported into your namespace, versus
-thirty-eight in the constants interface. On the flip side, the constants
-interface has the advantage of better compile time error checking, since
-misspelled names of colors or attributes in calls to color() and colored()
-won't be caught until runtime whereas misspelled names of constants will
-be caught at compile time. So, pollute your namespace with almost two
-dozen subroutines that you may not even use that often, or risk a silly
-bug by mistyping an attribute. Your choice, TMTOWTDI after all.
+thirty-eight in the constants interface, and aliases and true color attributes
+are supported. On the flip side, the constants interface has the advantage of
+better compile time error checking, since misspelled names of colors or
+attributes in calls to color() and colored() won't be caught until runtime
+whereas misspelled names of constants will be caught at compile time. So,
+pollute your namespace with almost two dozen subroutines that you may not even
+use that often, or risk a silly bug by mistyping an attribute. Your choice,
+TMTOWTDI after all.
=head2 The Color Stack
string of color constants. It can't ask the terminal what the current
attributes are.
+=head2 Supporting CLICOLOR
+
+L<https://bixense.com/clicolors/> proposes a standard for enabling and
+disabling color output from console commands using two environment variables,
+CLICOLOR and CLICOLOR_FORCE. Term::ANSIColor cannot automatically support
+this standard, since the correct action depends on where the output is going
+and Term::ANSIColor may be used in a context where colors should always be
+generated even if CLICOLOR is set in the environment. But you can use the
+supported environment variable ANSI_COLORS_DISABLED to implement CLICOLOR in
+your own programs with code like this:
+
+ if (exists($ENV{CLICOLOR}) && $ENV{CLICOLOR} == 0) {
+ if (!$ENV{CLICOLOR_FORCE}) {
+ $ENV{ANSI_COLORS_DISABLED} = 1;
+ }
+ }
+
+If you are using the constant interface, be sure to include this code before
+you use any color constants (such as at the very top of your script), since
+this environment variable is only honored the first time a color constant is
+seen.
+
+Be aware that this will export ANSI_COLORS_DISABLED to any child processes of
+your program as well.
+
=head1 DIAGNOSTICS
=over 4
ANSI_COLORS_ALIASES='newcolor1=oldcolor1,newcolor2=oldcolor2'
-Whitespace is ignored.
+Whitespace is ignored. The alias value can be a single attribute or a
+space-separated list of attributes.
-For example the L<Solarized|http://ethanschoonover.com/solarized> colors
+For example the L<Solarized|https://ethanschoonover.com/solarized> colors
can be mapped with:
ANSI_COLORS_ALIASES='\
$Term::ANSIColor::AUTORESET, rather than the other way around, in
Term::ANSIColor 4.00, included in Perl 5.17.8.
-C<ansi16> through C<ansi255>, as aliases for the C<rgb> and C<grey>
-colors, and the corresponding C<on_ansi> names and C<ANSI> and C<ON_ANSI>
-constants, were added in Term::ANSIColor 4.06.
+C<ansi16> through C<ansi255>, as aliases for the C<rgb> and C<grey> colors,
+and the corresponding C<on_ansi> names and C<ANSI> and C<ON_ANSI> constants
+were added in Term::ANSIColor 4.06, included in Perl 5.25.7.
+
+Support for true color (the C<rNNNgNNNbNNN> and C<on_rNNNgNNNbNNN>
+attributes), defining aliases in terms of other aliases, and aliases mapping
+to multiple attributes instead of only a single attribute was added in
+Term::ANSIColor 5.00.
=head1 RESTRICTIONS
+Both colored() and many uses of the color constants will add the reset escape
+sequence after a newline. If a program mixes colored output to standard
+output with output to standard error, this can result in the standard error
+text having the wrong color because the reset escape sequence hasn't yet been
+flushed to the display (since standard output to a terminal is line-buffered
+by default). To avoid this, either set autoflush() on STDOUT or set
+$Term::ANSIColor::EACHLINE to C<"\n">.
+
It would be nice if one could leave off the commas around the constants
entirely and just say:
listed, although it's displayed as green in the Linux console, but it is
reportedly supported by urxvt.
-Note that codes 6 (rapid blink) and 9 (strike-through) are specified in
-ANSI X3.64 and ECMA-048 but are not commonly supported by most displays
-and emulators and therefore aren't supported by this module at the present
-time. ECMA-048 also specifies a large number of other attributes,
-including a sequence of attributes for font changes, Fraktur characters,
-double-underlining, framing, circling, and overlining. As none of these
-attributes are widely supported or useful, they also aren't currently
-supported by this module.
+Note that codes 6 (rapid blink) and 9 (strike-through) are specified in ANSI
+X3.64 and ECMA-048 but are not commonly supported by most displays and
+emulators and therefore aren't supported by this module. ECMA-048 also
+specifies a large number of other attributes, including a sequence of
+attributes for font changes, Fraktur characters, double-underlining, framing,
+circling, and overlining. As none of these 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.
+For information on true color support in various terminal emulators, see
+L<True Colour support|https://gist.github.com/XVilka/8346728>.
+
=head1 AUTHORS
Original idea (using constants) by Zenin, reimplemented using subs by Russ
=head1 COPYRIGHT AND LICENSE
-Copyright 1996 Zenin
+Copyright 1996-1998, 2000-2002, 2005-2006, 2008-2018, 2020 Russ Allbery
+<rra@cpan.org>
-Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2008, 2009, 2010,
-2011, 2012, 2013, 2014, 2015, 2016 Russ Allbery <rra@cpan.org>
+Copyright 1996 Zenin
Copyright 2012 Kurt Starsinic <kstarsinic@gmail.com>
objects and operator overloading.
ECMA-048 is available on-line (at least at the time of this writing) at
-L<http://www.ecma-international.org/publications/standards/Ecma-048.htm>.
+L<https://www.ecma-international.org/publications/standards/Ecma-048.htm>.
ISO 6429 is available from ISO for a charge; the author of this module
does not own a copy of it. Since the source material for ISO 6429 was
to obtain the ISO standard.
The 256-color control sequences are documented at
-L<http://invisible-island.net/xterm/ctlseqs/ctlseqs.html> (search for
+L<https://invisible-island.net/xterm/ctlseqs/ctlseqs.html> (search for
256-color).
+Information about true color support in various terminal emulators and test
+programs you can run to check the true color support in your terminal emulator
+are available at L<https://gist.github.com/XVilka/8346728>.
+
The current version of this module is always available from its web site
at L<https://www.eyrie.org/~eagle/software/ansicolor/>. It is also part
of the Perl core distribution as of 5.6.0.
=cut
+
+# Local Variables:
+# copyright-at-end-flag: t
+# End:
--- /dev/null
+#!/usr/bin/perl
+#
+# Tests for true color support (24-bit color).
+#
+# Copyright 2020 Russ Allbery <rra@cpan.org>
+#
+# SPDX-License-Identifier: GPL-1.0-or-later OR Artistic-1.0-Perl
+
+use 5.008;
+use strict;
+use warnings;
+
+use Test::More tests => 82;
+
+# Load the module.
+BEGIN {
+ delete $ENV{ANSI_COLORS_ALIASES};
+ delete $ENV{ANSI_COLORS_DISABLED};
+ use_ok('Term::ANSIColor', qw(color uncolor colorvalid));
+}
+
+# Test basic true color codes.
+is(color('r0g0b0'), "\e[38;2;0;0;0m", 'foreground 0 0 0');
+is(color('r000g000b000'), "\e[38;2;0;0;0m", 'foreground 000 000 000');
+is(color('r255g0b0'), "\e[38;2;255;0;0m", 'foreground 255 0 0');
+is(color('r0g255b0'), "\e[38;2;0;255;0m", 'foreground 255 0 0');
+is(color('r0g0b255'), "\e[38;2;0;0;255m", 'foreground 255 0 0');
+is(color('r255g255b255'), "\e[38;2;255;255;255m", 'foreground 255 255 255');
+is(color('r1g02b003'), "\e[38;2;1;2;3m", 'foreground 1 02 003');
+is(color('on_r0g0b0'), "\e[48;2;0;0;0m", 'background 0 0 0');
+is(color('on_r000g000b000'), "\e[48;2;0;0;0m", 'background 000 000 000');
+is(color('on_r255g0b0'), "\e[48;2;255;0;0m", 'background 255 0 0');
+is(color('on_r0g255b0'), "\e[48;2;0;255;0m", 'background 255 0 0');
+is(color('on_r0g0b255'), "\e[48;2;0;0;255m", 'background 255 0 0');
+is(color('on_r255g255b255'), "\e[48;2;255;255;255m", 'background 255 255 255');
+is(color('on_r1g02b003'), "\e[48;2;1;2;3m", 'background 1 02 003');
+
+# Check that various true color codes are valid.
+my @valid = qw(
+ r0g0b0 r255g255b255 r1g02b003 on_r0g0b0 on_r255g255b255 on_r1g02b003
+);
+for my $color (@valid) {
+ ok(colorvalid($color), "Color $color is valid");
+}
+
+# Errors at boundary cases.
+my @invalid = qw(
+ r0g0 r256g0b0 r0g256b0 r0g0b256 r1000g2b3 rgb r1g2b r1gb2 r1b2g3
+);
+for my $color (@invalid) {
+ my $output = eval { color($color) };
+ is($output, undef, 'color on an invalid attribute 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 uncolor with true color codes.
+is_deeply([uncolor('38;2;0;0;0')], ['r0g0b0'], 'uncolor of r0g0b0');
+is_deeply([uncolor('48;02;0;0;0')], ['on_r0g0b0'], 'uncolor of on_r0g0b0');
+is_deeply([uncolor("\e[038;2;255;255;255")],
+ ['r255g255b255'], 'uncolor of r255g255b255');
+is_deeply([uncolor("\e[48;002;255;255;255")],
+ ['on_r255g255b255'], 'uncolor of on_r255g255b255');
+is_deeply(
+ [uncolor("\e[1;38;2;1;02;003;5;48;2;4;5;6m")],
+ [qw(bold r1g2b3 blink on_r4g5b6)],
+ 'uncolor of a complex escape',
+);
+is_deeply(
+ [uncolor("\e[1;38;2;1;02;003;5;48;5;230m")],
+ [qw(bold r1g2b3 blink on_rgb554)],
+ 'uncolor mixing true-color and 256-color',
+);
+
+# An invalid true-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[38;1m" => 38,
+ "\e[38;2m" => 38,
+ "\e[38;2;255;0m" => 38,
+ "\e[38;2;256;0;0m" => '38;2;256;0;0',
+ "\e[38;2;0;256;0m" => '38;2;0;256;0',
+ "\e[38;2;0;0;256m" => '38;2;0;0;256',
+ "\e[38;2;777;777;777m" => '38;2;777;777;777',
+ "\e[48;1m" => 48,
+ "\e[48;2m" => 48,
+ "\e[48;2;255;0m" => 48,
+ "\e[48;2;256;0;0m" => '48;2;256;0;0',
+ "\e[48;2;0;256;0m" => '48;2;0;256;0',
+ "\e[48;2;0;0;256m" => '48;2;0;0;256',
+ "\e[48;2;777;777;777m" => '48;2;777;777;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'
+ );
+}
https://perl5.git.perl.org / perl5.git / commitdiff