diff options
| -rw-r--r-- | lib/Term/ANSIColor.pm | 45 | ||||
| -rw-r--r-- | lib/Term/ANSIColor/ChangeLog | 21 | ||||
| -rw-r--r-- | lib/Term/ANSIColor/README | 6 | ||||
| -rw-r--r-- | lib/Term/ANSIColor/t/basic.t | 42 |
4 files changed, 99 insertions, 15 deletions
diff --git a/lib/Term/ANSIColor.pm b/lib/Term/ANSIColor.pm index e0ba6f5c05..d640908d47 100644 --- a/lib/Term/ANSIColor.pm +++ b/lib/Term/ANSIColor.pm @@ -17,7 +17,7 @@ package Term::ANSIColor; require 5.001; -$VERSION = '2.00'; +$VERSION = '2.01'; use strict; use vars qw($AUTOLOAD $AUTOLOCAL $AUTORESET @COLORLIST @COLORSTACK $EACHLINE @@ -32,7 +32,7 @@ BEGIN { 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) ]); @@ -98,11 +98,9 @@ sub AUTOLOAD { 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 && \@_) { @@ -181,7 +179,7 @@ sub uncolor { $escape =~ s/m$//; unless ($escape =~ /^((?:\d+;)*\d*)$/) { require Carp; - Carp::croak ("Bad escape sequence $_"); + Carp::croak ("Bad escape sequence $escape"); } push (@nums, split (/;/, $1)); } @@ -226,6 +224,17 @@ sub colored { } } +# 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 ############################################################################## @@ -256,7 +265,10 @@ reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com 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; @@ -285,8 +297,11 @@ reimplemented Allbery PUSHCOLOR POPCOLOR LOCALCOLOR openmethods.com =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 @@ -298,6 +313,10 @@ handle, or do anything else with it that you might care to). 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 @@ -335,6 +354,8 @@ default background color for the next line. Programs like pagers can also 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, @@ -377,6 +398,8 @@ 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 + 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 diff --git a/lib/Term/ANSIColor/ChangeLog b/lib/Term/ANSIColor/ChangeLog index 4fb57bfe48..47e2c1f167 100644 --- a/lib/Term/ANSIColor/ChangeLog +++ b/lib/Term/ANSIColor/ChangeLog @@ -1,3 +1,24 @@ +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. diff --git a/lib/Term/ANSIColor/README b/lib/Term/ANSIColor/README index 3e4349a1b0..834a43f991 100644 --- a/lib/Term/ANSIColor/README +++ b/lib/Term/ANSIColor/README @@ -1,4 +1,4 @@ - 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 @@ -148,4 +148,8 @@ THANKS 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. diff --git a/lib/Term/ANSIColor/t/basic.t b/lib/Term/ANSIColor/t/basic.t index 790065e5f5..fe01a1dbde 100644 --- a/lib/Term/ANSIColor/t/basic.t +++ b/lib/Term/ANSIColor/t/basic.t @@ -1,4 +1,4 @@ -#!/usr/bin/perl +#!/usr/bin/perl -Tw # # t/basic.t -- Test suite for the Term::ANSIColor Perl module. # @@ -9,11 +9,11 @@ # 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. @@ -84,3 +84,39 @@ is (POPCOLOR . "text", "\e[31m\e[42mtext", 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'); |