diff --git a/.gitignore b/.gitignore index b0a170d..3113bd0 100644 --- a/.gitignore +++ b/.gitignore @@ -1,8 +1,9 @@ -Makefile -Makefile.old blib -pm_to_blib -TEST dist +Makefile +Makefile.old MYMETA.json MYMETA.yml +pm_to_blib +t.html +TEST diff --git a/Changes b/Changes index a275de2..07a58b2 100644 --- a/Changes +++ b/Changes @@ -5,6 +5,7 @@ (There's also a coloralias() sub now, but you can't replace standard colors, so it's not useful here.) - use color() and colorvalid() instead of more scope hacking + - export color() and colorvalid() (et al) insteadof scope hacking - move most of the hi command to App::HI 2.7186: Sat Jun 21 2014 diff --git a/MANIFEST b/MANIFEST index 07585a0..e407cf2 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,13 +2,12 @@ bin/hi Changes lib/App/HI.pm lib/Term/ANSIColorx/AutoFilterFH.pm -lib/Term/ANSIColorx/AutoFilterFH.pod lib/Term/ANSIColorx/ColorNicknames.pm -lib/Term/ANSIColorx/ColorNicknames.pod Makefile.PL MANIFEST README t/01_color_some_things.t +t/02_fix_some_things.t t/05_color_file_handle.t t/07_test_hi.t t/09_test_no_extra_and_trunc.t diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP index 1d02ba6..2c3ab42 100644 --- a/MANIFEST.SKIP +++ b/MANIFEST.SKIP @@ -4,4 +4,5 @@ ^Makefile.old ^MANIFEST\.SKIP$ new-version.sh +t.html TEST diff --git a/Makefile.PL b/Makefile.PL index 617ea63..238ec9c 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -12,6 +12,7 @@ WriteMakefile( PREREQ_PM => { 'Term::ANSIColor' => 4.0, 'Text::Table' => 0, + 'Text::Size' => 0, }, ($ExtUtils::MakeMaker::VERSION ge '6.48'? diff --git a/lib/App/HI.pm b/lib/App/HI.pm index f30ee36..81bdbc9 100644 --- a/lib/App/HI.pm +++ b/lib/App/HI.pm @@ -3,20 +3,33 @@ package App::HI; use strict; use Text::Table; +use Term::Size; our $VERSION = '2.7187'; -sub fire_filter { - my $truncate = shift; +sub top_matter { my $no_extra = shift; - unless( $no_extra ) { - eval q { use Term::ANSIColorx::ColorNicknames; 1 } + if( $no_extra ) { + eval q { use Term::ANSIColorx::AutoFilterFH qw(filtered_handle); 1 } + or die $@; + + } else { + eval q { use Term::ANSIColorx::AutoFilterFH qw(colorpackage=Term::ANSIColorx::ColorNicknames filtered_handle); 1 } or die $@; } - eval q { use Term::ANSIColorx::AutoFilterFH qw(filtered_handle); 1 } - or die $@; + if( @_ ) { + eval qq/ use Term::ANSIColor qw(@_); 1 / + or die $@; + } +} + +sub fire_filter { + my $truncate = shift; + my $no_extra = shift; + + top_matter( $no_extra ); my $newstdout = filtered_handle(\*STDOUT, @ARGV); $| = 1; my $oldstdout = select $newstdout; $|=1; @@ -31,6 +44,54 @@ sub fire_filter { } sub list_colors { + my $truncate = shift; + my $no_extra = shift; + + top_matter( $no_extra => qw(color colorvalid) ); + + my $table; + + my @colors = ( + qw( black red green yellow blue magenta cyan white ), + map("bold $_", qw( black red green yellow blue magenta cyan white )), + map("bright_$_", qw( black red green yellow blue magenta cyan white )), + + "white on_black", "white on_red", "blue on_green", "black on_yellow", + "white on_blue", "white on_magenta", "black on_cyan", "black on_white" + ); + + @colors = grep { + my $valid = colorvalid($_); + warn "$_ isn't valid" unless $valid; + + $valid} @colors; + + my ($columns, $rows) = Term::Size::chars *STDOUT; + + $columns --; + + my $m = 20; + UGH_SO_BAD: { + # XXX: this is so in-efficient it makes my soul hurt + $table = Text::Table->new; + + my @row; + for(@colors) { + push @row, $_; + + unless( @row % $m ) { + $table->add(map {color($_) . $_ . color("reset")} @row); + @row = (); + } + } + + $table->add(@row) if @row; + + $m -= 2; + redo UGH_SO_BAD if $table->width > $columns; + } + + print $table; } __END__ diff --git a/lib/Term/ANSIColorx/AutoFilterFH.pm b/lib/Term/ANSIColorx/AutoFilterFH.pm index 0da3bc3..88d1353 100644 --- a/lib/Term/ANSIColorx/AutoFilterFH.pm +++ b/lib/Term/ANSIColorx/AutoFilterFH.pm @@ -1,19 +1,34 @@ package Term::ANSIColorx::AutoFilterFH; -use strict; -use warnings; -no warnings 'uninitialized'; # sometimes it's ok to compare undef... jesus - use Carp; use Symbol; use Tie::Handle; -use Term::ANSIColor qw(color colorvalid); use base 'Tie::StdHandle'; use base 'Exporter'; -our $VERSION = '2.7187'; +sub import { + my @__; + my $color_package = Term::ANSIColorx::ColorNicknames->can("import") ? "Term::ANSIColorx::ColorNicknames" : "Term::ANSIColor"; + + for(@_) { + if( m/\Acolor.?package\s*=\s*(\S+)\z/ ) { + $color_package = $1 + + } else { + push @__, $_ + } + } + + eval qq{ use $color_package qw(color colorvalid); 1 } + or die $@; + + __PACKAGE__->export_to_level(1, @__); +} + +use common::sense; +our $VERSION = '2.7187'; our @EXPORT_OK = qw(filtered_handle); my %pf2t; @@ -21,8 +36,7 @@ my %orig; my %pats; my %trun; -my @icolors = (""); -my $RESET = color("reset"); +my (@icolors, $RESET); # DESTROY {{{ sub DESTROY { @@ -94,6 +108,9 @@ sub filtered_handle { my ($fh, @patterns) = @_; croak "filtered_handle(globref, \@patterns)" unless ref($fh) eq "GLOB"; + @icolors = (""); + $RESET = color("reset"); + my @pats; while( (my ($pat,$color) = splice @patterns, 0, 2) ) { croak "\@patterns should contain an even number of items" unless defined $color; @@ -106,13 +123,10 @@ sub filtered_handle { # die unless all the elements of @uc are all caps exports of # Term::ANSIColor - $color =~ s/[^\w]/ /g; - $color =~ s/on (\w+)/on_$1/g; - croak "color \"$color\" unknown" unless colorvalid($color); + $color = color($color); - my $color = color($color); - my ($l) = grep {$color eq $icolors[$_]} 0 .. $#icolors; + my ($l) = grep {$color eq $icolors[$_]} 0 .. $#icolors; unless($l) { push @icolors, $color; @@ -136,3 +150,76 @@ sub filtered_handle { # }}} "true"; + +__END__ + +=head1 NAME + +Term::ANSIColorx::AutoFilterFH - automatically color-highlight a stream + +=head1 SYNOPSIS + + use Term::ANSIColorx::ColorNicknames; # optional + use Term::ANSIColorx::AutoFilterFH qw(filtered_handle); + + my $filtered_stdout = filtered_handle(\*STDOUT, + 'jettero' => 'bold-blue', + 'nobody' => 'sky', # same as jettero under ColorNicks, or error + 'root' => 'red', + ); + + print "This has colors: jettero nobody root\n"; + + select $filtered_stdout; + print "This also has colors. -jettero\n"; + + $filtered_stdout->set_truncate(80); + print "This line is only 80 characters... ", ("." x 120), "\n"; + +=head1 DESCRIPTION + +I wanted a way to inject colors into places that didn't otherwise support it. I +also wanted to make my L utility as short as possible -- and it worked. +L is barely three lines, not including the options. + +=head1 C + +This function returns a tied handle with some magic installed. You can print to +it and select it. It has one method you can invoke as well. + +=head1 C + +Use this method to set a characters-per-line limit. Give it an C or a +C<0> to disable it again. Caveat: The truncator assumes input to C +is a I and as such, the results will seem incorrect when the printing +non-lines. For example, this will not work right: + + $truncated_handle->set_truncate(80) + select $truncated_handle; + print "neato: ", ("." x 120); # this will gain a newline at char 81 + print "\n"; + +=head1 FAQ + +Q: You don't seem to understand Tie::Handle, shouldn't you fix it using my +immense knowledge of perl FH globs? + +A: You got that right -- although the module functions correctly -- if you want +to help, let me know, or fork the project on github. + +=head1 REPORTING BUGS + +You can report bugs either via rt.cpan.org or via the issue tracking system on +github. I'm likely to notice either fairly quickly. + +=head1 AUTHOR + +Paul Miller C<< >> + +=head1 COPYRIGHT + +Copyright 2009 Paul Miller -- released under the GPL + +=head1 SEE ALSO + +perl(1), L, L diff --git a/lib/Term/ANSIColorx/AutoFilterFH.pod b/lib/Term/ANSIColorx/AutoFilterFH.pod deleted file mode 100644 index 446a932..0000000 --- a/lib/Term/ANSIColorx/AutoFilterFH.pod +++ /dev/null @@ -1,71 +0,0 @@ - -=head1 NAME - -Term::ANSIColorx::AutoFilterFH - automatically color-highlight a stream - -=head1 SYNOPSIS - - use Term::ANSIColorx::ColorNicknames; # optional - use Term::ANSIColorx::AutoFilterFH qw(filtered_handle); - - my $filtered_stdout = filtered_handle(\*STDOUT, - 'jettero' => 'bold-blue', - 'nobody' => 'sky', # same as jettero under ColorNicks, or error - 'root' => 'red', - ); - - print "This has colors: jettero nobody root\n"; - - select $filtered_stdout; - print "This also has colors. -jettero\n"; - - $filtered_stdout->set_truncate(80); - print "This line is only 80 characters... ", ("." x 120), "\n"; - -=head1 DESCRIPTION - -I wanted a way to inject colors into places that didn't otherwise support it. I -also wanted to make my L utility as short as possible -- and it worked. -L is barely three lines, not including the options. - -=head1 C - -This function returns a tied handle with some magic installed. You can print to -it and select it. It has one method you can invoke as well. - -=head1 C - -Use this method to set a characters-per-line limit. Give it an C or a -C<0> to disable it again. Caveat: The truncator assumes input to C -is a I and as such, the results will seem incorrect when the printing -non-lines. For example, this will not work right: - - $truncated_handle->set_truncate(80) - select $truncated_handle; - print "neato: ", ("." x 120); # this will gain a newline at char 81 - print "\n"; - -=head1 FAQ - -Q: You don't seem to understand Tie::Handle, shouldn't you fix it using my -immense knowledge of perl FH globs? - -A: You got that right -- although the module functions correctly -- if you want -to help, let me know, or fork the project on github. - -=head1 REPORTING BUGS - -You can report bugs either via rt.cpan.org or via the issue tracking system on -github. I'm likely to notice either fairly quickly. - -=head1 AUTHOR - -Paul Miller C<< >> - -=head1 COPYRIGHT - -Copyright 2009 Paul Miller -- released under the GPL - -=head1 SEE ALSO - -perl(1), L, L diff --git a/lib/Term/ANSIColorx/ColorNicknames.pm b/lib/Term/ANSIColorx/ColorNicknames.pm index 652fab7..62377ff 100644 --- a/lib/Term/ANSIColorx/ColorNicknames.pm +++ b/lib/Term/ANSIColorx/ColorNicknames.pm @@ -1,68 +1,331 @@ package Term::ANSIColorx::ColorNicknames; -use strict; -use warnings; -use Term::ANSIColor; +use Term::ANSIColor qw(colorstrip uncolor); +use common::sense; +use base 'Exporter'; our $VERSION = '2.7187'; +our @FIXED = qw(color colorvalid colored); +our @EXPORT_OK = qw(fix_color color colorvalid colored colorstrip uncolor); +our %EXPORT_TAGS = ( all => \@EXPORT_OK, fixed=>\@FIXED ); + our %NICKNAMES = ( - blood => "31", - umber => "1;31", - sky => "1;34", - ocean => "36", - lightblue => "36", - cyan => "1;36", - lime => "1;32", - orange => "33", - brown => "33", - yellow => "1;33", - purple => "35", - violet => "1;35", - black => "1;30", - pitch => "30", - grey => "37", - gray => "37", - white => "1;37", - dire => "1;33;41", - alert => "0;33;41", - todo => "30;43", - - nc_dir => "37;44", - nc_file => "1;37;44", - nc_exe => "1;32;44", - nc_exec => "1;32;44", - nc_curs => "46", - nc_pwd => "0;30;47", - nc_cwd => "0;30;47", - - mc_dir => "37;44", - mc_file => "1;37;44", - mc_exe => "1;32;44", - mc_exec => "1;32;44", - mc_curs => "46", - mc_pwd => "0;30;47", - mc_cwd => "0;30;47", + blood => "red", + umber => "bold red", + sky => "bold blue", + ocean => "cyan", + lightblue => "cyan", + cyan => "bold cyan", + lime => "bold green", + orange => "yellow", + brown => "yellow", + yellow => "bold yellow", + purple => "magenta", + violet => "bold magenta", + pink => "bold magenta", + black => "bold black", + pitch => "black", + grey => "white", + gray => "white", + white => "bold white", + + dire => "bold yellow on_red", + alert => "bold yellow on_red", + todo => "black on_yellow", + + nc_dir => "bold white on_blue", + nc_file => "bold white on_blue", + nc_exe => "bold green on_blue", + nc_exec => "bold green on_blue", + nc_curs => "black on_cyan", + nc_pwd => "black on_white", + nc_cwd => "black on_white", + + mc_dir => "bold white on_blue", + mc_file => "bold white on_blue", + mc_exe => "bold green on_blue", + mc_exec => "bold green on_blue", + mc_curs => "black on_cyan", + mc_pwd => "black on_white", + mc_cwd => "black on_white", ); -@Term::ANSIColor::ATTRIBUTES{keys %NICKNAMES} = values %NICKNAMES; -{ - my %tmp = (); - @tmp{ @Term::ANSIColor::COLORLIST, map {uc $_} keys %NICKNAMES } = (); - @Term::ANSIColor::COLORLIST = keys %tmp; +sub fix_color(_) { + my $color = shift; - for my $key (qw(constants pushpop)) { - %tmp = (); - @tmp{ @{$Term::ANSIColor::EXPORT_TAGS{$key}}, @Term::ANSIColor::COLORLIST } = (); - $Term::ANSIColor::EXPORT_TAGS{$key} = [keys %tmp]; - } + return $color if $color =~ s/\a//g; + + $color =~ s/[^\w]/ /g; + $color =~ s/on (\w+)/on_$1/g; + + $color = join " ", map {exists $NICKNAMES{$_} ? $NICKNAMES{$_} : $_} grep{$_} split " ", $color; + + 1 while $color =~ s/bold\s+bold/bold/g; + 1 while $color =~ s/on_\w+(\s+on_\w+)/$1/g; - local *EXPORT = \@Term::ANSIColor::EXPORT; - local *EXPORT_OK = \@Term::ANSIColor::EXPORT_OK; - local *EXPORT_TAGS = \%Term::ANSIColor::EXPORT_TAGS; + return $color; +} + +sub color(_) { + @_ = (fix_color $_[0]); + goto &Term::ANSIColor::color; +} - Exporter::export_ok_tags ('pushpop'); +sub colorvalid(_) { + @_ = (fix_color $_[0]); + goto &Term::ANSIColor::colorvalid; +} + +sub colored { + my ($string, @codes); + + if (ref $_[0]) { + @codes = @{+shift}; + $string = join ('', @_); + + } else { + $string = shift; + @codes = @_; + } + + return $Term::ANSIColor::colored($string, map {fix_color} @codes); } "true"; + +__END__ + +=encoding UTF-8 + +=head1 NAME + +Term::ANSIColorx::ColorNicknames - nicknames for the ANSI colors + +=head1 SYNOPSIS + + # use Term::ANSIColor qw(color colorvalid); + use Term::ANSIColorx::ColorNicknames qw(color colorvalid); + +=head1 DESCRIPTION + +I have a hard time remembering the ANSI colors in terms of bolds and regulars, +and also find them irritating to type. If I want the color yellow, why should I +have to type C<"bright_yellow"> to get it? C is really orange +colored, yellow should always be bold. Also, the color C is basically +useless — on a black background at least, which is my modus operandi, your +mileage may vary — so I made C more of a dark grey. Actual black can be +found via the color C. + +=head1 HOW THIS WORKS + +In the past, this module used to replace the exports of the Term::ANSIColor +package. I was under the impression I am the only user of this package, so I +felt comfortable breaking backwards compatability with versions prior to +C<2.7187>. Lemme know if I jacked up your codes, but please adapt to the new +setup. The old stuff was pretty janky. Kinda cool scope hacking, but janky. + +This module exports the following functions, which “override” the functions +from L. They use the word “fix” instead of translate because +it’s short, not because it’s a political statement about the ANSI definitions +or L. + +=over + +=item C + +Re-writes the (correct) ANSI color to the new nickname color. Additionally, it +re-writes various easy to type natural language (or css feeling) punctuations. + + "bold blue" eq fix_color("sky") + "bold blue" eq fix_color("bold-blue") + + "bold white on_blue" = color("bold-white on blue") + +(Note that C is really C<"bold white"> under this package. +C automatically fixes C<"bold bold white"> should it come up by +accident.) + +Additionally, C uses the prototype C<_>, so one can do this: + + @xlated = map{fix_color} qw(sky ocean blood umber); + +which gives: + + ("bold blue", "cyan", "red", "bold red") + +and of course, this: + + "bold blue" eq fix_color "sky"; + +Lastly, there's a secret code to disable the re-writing. If you decide you +hate one of the nicknames, or just want to disable it for a single color, +intoduce a bell character anywhere in the string. + + "bold black" eq fix_color "black"; + "black" eq fix_color "\ablack"; + +(This makes more sense if you export L> below. + +=item C + +This is just an export of L. It runs +L> on the given string and then invokes C. +Additionally, C is defined with the C<_> prototype, which means it can be invoked this way: + + say color "violet", "test test test test", color "reset" + +Or like this: + + while(<$colorstream>) { + chomp; + print color if colorvalid; + say "TEST: o rly? (color=$_)"; + } + + print color("reset"); + +=item C + +Like above, this is just a C<_> prototyped and C translated export of L. + +=item C + +Translated (but not C<_> prototyped) export of L. + +=item C + +Boring re-import of L. This is not translated or prototyped. + +=item C + +Boring re-import of L. This is not translated or prototyped. + +=back + +=head1 THE NICKNAMES + +=over + +=item C + +Alias for the color red. + +=item C + +Alias for bold red. + +=item C + +Alias for bold blue. + +=item C + +Replaces the color cyan, which should be very bright. + +=item C + +Alias for ocean. + +=item C + +Cyan is the bold of the ocean. It's a bright cyan color. + +=item C + +Bolded green. It's really a lime color. + +=item C C + +Orange. Most correctly, what ANSI calls "yellow", but is really more of a +brown-orange. + +=item C + +Yellow. Technically bolded yellow. + +=item C + +Alias for magenta. I can never remember which is right, probably thanks to CSS. + +=item C + +Bolded purple. + +=item C + +Bolded purple. + +=item C + +Bolded black. On dark backgrounds, black is useless. + +=item C + +Actual black. + +=item C C + +Unbolded white. + +=item C + +Bolded white. + +=item C + +Scary yellow on red warning color. + +=item C + +Scary white on red color. + +=item C + +Iconic black on orange todo coloring. + +=item C<"mc_dir"> C<"nc_dir"> + +The white on blue directory coloring from Midnight Commander. + +=item C<"mc_file"> C<"nc_file"> + +The grey on blue file coloring. + +=item C<"mc_exe"> C<"nc_exe"> C<"mc_exec"> C<"nc_exec"> + +The lime on blue executable coloring. + +=item C<"mc_curs"> C<"nc_curs"> + +The cursor bar black on cyan coloring. + +=item C<"mc_pwd"> C<"nc_pwd"> C<"mc_cwd"> C<"nc_cwd"> + +The black on white coloring of the current directory on the current panel. + +=back + +=head1 FAQ + + Q: This is dumb. + + A: That's not a question, but you're right. I still use it. + +=head1 REPORTING BUGS + +You can report bugs either via rt.cpan.org or via the issue tracking system on +github. I'm likely to notice either fairly quickly. + +=head1 AUTHOR + +Paul Miller C<< >> + +=head1 COPYRIGHT + +Copyright 2014 Paul Miller -- released under the GPL + +=head1 SEE ALSO + +perl(1), L diff --git a/lib/Term/ANSIColorx/ColorNicknames.pod b/lib/Term/ANSIColorx/ColorNicknames.pod deleted file mode 100644 index 852eb63..0000000 --- a/lib/Term/ANSIColorx/ColorNicknames.pod +++ /dev/null @@ -1,143 +0,0 @@ - -=head1 NAME - -Term::ANSIColorx::ColorNicknames - nicknames for the ANSI colors - -=head1 SYNOPSIS - - use Term::ANSIColorx::ColorNicknames; # messes with ANSIColor - use Term::ANSIColor qw(:constants); # now exports the nicknames - -=head1 DESCRIPTION - -I have a hard time remembering the ANSI colors in terms of bolds and regulars, -and also find them irritating to type. If I want the color yellow, why should I -have to type C to get it? C is really orange -colored, yellow should always be bold. Also, the color C is basically -useless, on a black background at least, which is my modus operandi, your -mileage may vary. - -=head1 THE NICKNAMES - -Except where they are intentionally overwritten, the original L -names should still be exported correctly. - -=over - -=item C - -Alias for the color red. - -=item C - -Alias for bold red. - -=item C - -Alias for bold blue. - -=item C - -Replaces the color cyan, which should be very bright. - -=item C - -Alias for ocean. - -=item C - -Cyan is the bold of the ocean. It's a bright cyan color. - -=item C - -Bolded green. It's really a lime color. - -=item C C - -Orange. Most correctly, what ANSI calls "yellow", but is really more of a -brown-orange. - -=item C - -Yellow. Technically bolded yellow. - -=item C - -Alias for magenta. I can never remember which is right, probably thanks to CSS. - -=item C - -Bolded purple. - -=item C - -Bolded black. On dark backgrounds, black is useless. - -=item C - -Actual black. - -=item C C - -Unbolded white. - -=item C - -Bolded white. - -=item C - -Scary yellow on red warning color. - -=item C - -Scary white on red color. - -=item C - -Iconic black on orange todo coloring. - -=item C C - -The white on blue directory coloring from Midnight Commander. - -=item C C - -The grey on blue file coloring. - -=item C C C C - -The lime on blue executable coloring. - -=item C C - -The cursor bar black on cyan coloring. - -=item C C C C - -The black on white coloring of the current directory on the current panel. - -=back - -=head1 FAQ - - Q: This is dumb. - - A: That's not a question, but you're right. I still use it. - -=head1 REPORTING BUGS - -You can report bugs either via rt.cpan.org or via the issue tracking system on -github. I'm likely to notice either fairly quickly. - -=head1 AUTHOR - -Paul Miller C<< >> - -=head1 COPYRIGHT - -Copyright 2014 Paul Miller -- released under the GPL - -=head1 SEE ALSO - -perl(1), L diff --git a/t/01_color_some_things.t b/t/01_color_some_things.t index f27c785..2531f52 100644 --- a/t/01_color_some_things.t +++ b/t/01_color_some_things.t @@ -4,11 +4,12 @@ use strict; use warnings; use Test; -use Term::ANSIColorx::ColorNicknames; -use Term::ANSIColor qw(:constants); +use Term::ANSIColorx::ColorNicknames qw(:all); -plan tests => 2; +plan tests => 3; -my $string = BLOOD . "red" . SKY . "blue"; -ok( $string =~ m/\e\[31m/ ); -ok( $string =~ m/\e\[1;34m/ ); +my $string = color("red") . "red " . color("sky") . "sky" . color("reset"); + +ok( $string, qr/\e\[31mred/ ); +ok( $string, qr/\e\[1;34msky/ ); +ok( $string, qr/\e\[0?m$/ ); diff --git a/t/02_fix_some_things.t b/t/02_fix_some_things.t new file mode 100644 index 0000000..e5eeb5c --- /dev/null +++ b/t/02_fix_some_things.t @@ -0,0 +1,18 @@ + +use strict; +use warnings; + +use Test; +use Term::ANSIColorx::ColorNicknames qw(fix_color); + +my %fix_these = ( + "bold-blue on white" => "bold blue on_white", + "bold sky-on-white" => "bold blue on_white", + "\ablack" => "black", + black => "bold black", +); + +plan tests => 0 + (keys %fix_these); + +ok( fix_color $_, $fix_these{$_} ) + for keys %fix_these; diff --git a/t/05_color_file_handle.t b/t/05_color_file_handle.t index a78b8a4..22fea47 100644 --- a/t/05_color_file_handle.t +++ b/t/05_color_file_handle.t @@ -15,5 +15,5 @@ close FILE; open FILE, "TEST" or die $!; my $contents = do {local $/; }; -ok( $contents =~ m/\e\[1;34mtest1\e\[0?m/ ); -ok( $contents =~ m/\e\[31mtest2\e\[0?m/ ); +ok( $contents, qr/\e\[1;34mtest1\e\[0?m/ ); +ok( $contents, qr/\e\[31mtest2\e\[0?m/ ); diff --git a/t/07_test_hi.t b/t/07_test_hi.t index 46159de..7b2274c 100644 --- a/t/07_test_hi.t +++ b/t/07_test_hi.t @@ -13,5 +13,5 @@ open FILE, "TEST" or die $!; my $contents = ; close FILE; -ok( $contents =~ m/\e\[1;34mtest1\e\[0?m/ ); -ok( $contents =~ m/\e\[31mtest2\e\[0?m/ ); +ok( $contents, qr/\e\[1;34mtest1\e\[0?m/ ); +ok( $contents, qr/\e\[31mtest2\e\[0?m/ );