package Term::ANSIColor;
require 5.001;
-$VERSION = '2.00';
+$VERSION = '2.01';
use strict;
use vars qw($AUTOLOAD $AUTOLOCAL $AUTORESET @COLORLIST @COLORSTACK $EACHLINE
ON_CYAN ON_WHITE);
@ISA = qw(Exporter);
@EXPORT = qw(color colored);
- @EXPORT_OK = qw(uncolor);
+ @EXPORT_OK = qw(uncolor colorstrip);
%EXPORT_TAGS = (constants => \@COLORLIST,
pushpop => [ @COLORLIST,
qw(PUSHCOLOR POPCOLOR LOCALCOLOR) ]);
if (defined $ENV{ANSI_COLORS_DISABLED}) {
return join ('', @_);
}
- my $sub;
- ($sub = $AUTOLOAD) =~ s/^.*:://;
- my $attr = $ATTRIBUTES{lc $sub};
- if ($sub =~ /^[A-Z_]+$/ && defined $attr) {
- $attr = "\e[" . $attr . 'm';
+ if ($AUTOLOAD =~ /^([\w:]*::([A-Z_]+))$/ and defined $ATTRIBUTES{lc $2}) {
+ $AUTOLOAD = $1;
+ my $attr = "\e[" . $ATTRIBUTES{lc $2} . 'm';
eval qq {
sub $AUTOLOAD {
if (\$AUTORESET && \@_) {
$escape =~ s/m$//;
unless ($escape =~ /^((?:\d+;)*\d*)$/) {
require Carp;
- Carp::croak ("Bad escape sequence $_");
+ Carp::croak ("Bad escape sequence $escape");
}
push (@nums, split (/;/, $1));
}
}
}
+# 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.
+sub colorstrip {
+ my (@string) = @_;
+ for my $string (@string) {
+ $string =~ s/\e\[[\d;]*m//g;
+ }
+ return wantarray ? @string : join ('', @string);
+}
+
##############################################################################
# Module return value and documentation
##############################################################################
print "\n";
use Term::ANSIColor qw(uncolor);
- print uncolor '01;31', "\n";
+ print uncolor ('01;31'), "\n";
+
+ use Term::ANSIColor qw(colorstrip);
+ print colorstrip '\e[1mThis is bold\e[0m', "\n";
use Term::ANSIColor qw(:constants);
print BOLD, BLUE, "This text is in bold blue.\n", RESET;
=head1 DESCRIPTION
This module has two interfaces, one through color() and colored() and the
-other through constants. It also offers the utility function uncolor(),
-which has to be explicitly imported to be used (see L</SYNOPSIS>).
+other through constants. It also offers the utility functions uncolor()
+and colorstrip(), which have to be explicitly imported to be used (see
+L</SYNOPSIS>).
+
+=head2 Function Interface
color() takes any number of strings as arguments and considers them to be
space-separated lists of attributes. It then forms and returns the escape
uncolor() performs the opposite translation, turning escape sequences
into a list of strings.
+colorstrip() removes all color escape sequences from the provided strings,
+returning the modified strings separately in array context or joined
+together in scalar context. Its arguments are not modified.
+
The recognized non-color attributes are clear, reset, bold, dark, faint,
underline, underscore, blink, reverse, and concealed. Clear and reset
(reset to default attributes), dark and faint (dim and saturated), and
be confused by attributes that span lines. Normally you'll want to set
$Term::ANSIColor::EACHLINE to C<"\n"> to use this feature.
+=head2 Constant Interface
+
Alternately, if you import C<:constants>, you can use the constants CLEAR,
RESET, BOLD, DARK, UNDERLINE, UNDERSCORE, BLINK, REVERSE, CONCEALED,
BLACK, RED, GREEN, YELLOW, BLUE, MAGENTA, CYAN, WHITE, ON_BLACK, ON_RED,
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
+
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
+2009-07-04 Russ Allbery <rra@stanford.edu>
+
+ * ANSIColor.pm: Version 2.01 released.
+
+ * t/basic.t: Test error handling in color, colored, and uncolor.
+
+ * ANSIColor.pm (uncolor): When reporting errors for bad escape
+ sequences, don't include the leading \e[ or trailing m in the
+ error message.
+
+ * ANSIColor.pm: Add section headings to the DESCRIPTION section of
+ the module since it's getting rather long.
+ (colorstrip): New function to remove ANSI color codes from
+ strings. Thanks, Paul Miller.
+ * t/basic.t: New tests for colorstrip.
+
+ * ANSIColor.pm (AUTOLOAD): Untaint $AUTOLOAD, required by Perl
+ 5.10 when running in taint mode. Thanks, Tim Bellinghausen.
+ * t/basic.t: Two new tests for AUTOLOAD error handling. Enable
+ warnings and taint mode.
+
2009-02-28 Russ Allbery <rra@stanford.edu>
* ANSIColor.pm: Version 2.00 released.
- Term::ANSIColor version 2.00
+ Term::ANSIColor version 2.01
(A simple ANSI text attribute control module)
Copyright 1996, 1997, 1998, 2000, 2001, 2002, 2005, 2006, 2007, 2009
To openmethods.com voice solutions for contributing PUSHCOLOR, POPCOLOR,
and LOCALCOLOR support.
+ To Tim Bellinghausen for the AUTOLOAD taint fix for Perl 5.10.
+
+ To Paul Miller for the idea and initial implementation of colorstrip.
+
To Larry Wall, as always, for Perl.
-#!/usr/bin/perl
+#!/usr/bin/perl -Tw
#
# t/basic.t -- Test suite for the Term::ANSIColor Perl module.
#
# under the same terms as Perl itself.
use strict;
-use Test::More tests => 29;
+use Test::More tests => 43;
BEGIN {
delete $ENV{ANSI_COLORS_DISABLED};
- use_ok ('Term::ANSIColor', qw/:pushpop color colored uncolor/);
+ use_ok ('Term::ANSIColor', qw/:pushpop color colored uncolor colorstrip/);
}
# Various basic tests.
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');
+
+# 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"),
+ "\e[2cSome other code\e and stray [0m stuff",
+ 'colorstrip does not remove non-color stuff');
+
+# 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');
+$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');
+$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');
+
+# 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');
projects / platform / upstream / perl.git / commitdiff