All the Perl that's Practical to Extract and Report

Highlight

pudge on 2004-12-15T23:00:00

Maybe something like this already exists, but I just wrote a quick little script that I call "highlight." It takes one argument, then reads STDIN and highlights that string on output with ANSI coloring (red).

#!/usr/bin/perl
my $word = shift;
while (<>) {
	s/\Q$word\E/\e[31m$word\e[0m/g;
	print;
}


So I can do fun things like:

% somebigdebuggingoutput | highlight 'what i am looking for'


It works great in conjunction with ls, locate, grep, etc.

Cool!

Ovid on 2004-12-15T23:14:29

That just went into my bin/ directory. Thanks!

At my last job, we used something similar to color the output of our tests. Failed tests showed up in red. Hmm...

grep?

gav on 2004-12-15T23:31:04

Or you can use: alias grep="grep --color"

Re:grep?

pudge on 2004-12-15T23:45:36

Yes, I know. :-)

Advent advocate

runrig on 2004-12-15T23:57:19

And with Term::ANSIColor you don't even have to remember or look up what the code for red is :-)

(I know...why complicate a perfectly simple thing :)

Re:Advent advocate

pudge on 2004-12-16T06:03:24

Yes, that's perfectly good, and to extend this in any significant direction, that would be the way to go.

Re:Advent advocate

davorg on 2004-12-16T10:20:54

Here's a version that uses Term::ANSIColor and takes a -c option to define the colour used.

#!/usr/bin/perl

use Term::ANSIColor ':constants';
use Getopt::Std;

my %opts;
getopts('c:w:', \%opts);

$opts{w} ||= shift;
$opts{c} = eval $opts{c} || RED;

while (<>) {
  s/\Q$opts{w}\E/$opts{c} . $opts{w} . RESET/ge;
  print;
}

Might want to add some code checking the contents of $opt{c} before running "eval" on it.

Re:Advent advocate

Aristotle on 2004-12-17T00:46:23

I wonder why everyone uses the :constants interface and eval()s their command line parameters. I've seen this meme in half a dozen different places now. The module has a perfectly good functional interface that makes this use case clearer too:

#!/usr/bin/perl -w
use strict;

use Term::ANSIColor;
use Getopt::Std;

getopts( 'e:c:', \my %opts );

my $rx = $opts{e} || shift;
my $color = $opts{c} || 'bold red';

while( <> ) {
    s{ ( $rx ) }{ colored( $1, $color ) }gex;
    print;
}

Re:Advent advocate

runrig on 2004-12-17T06:22:06

I like Aristotle's solution below, but I couldn't help but come up with this solution which checks the argument and then abuses how perl allows some kinds of symbolic references even under strict:
$opts{c} =
($opts{c} !~ /[^A-Z]/ && exists &{"Term::ANSIColor::$opts{c}"})
? &{ \&{"Term::ANSIColor::$opts{c}"} }
: RED;

Re:Advent advocate

runrig on 2004-12-17T20:47:08

Correction. I meant Aristotle's solution above, not the one below (the one below makes my eyes hurt) :-)

Yup - already exists

Jon Dowland on 2004-12-16T10:32:40

..but I don't blame you for not finding it :) http://www.alcopop.org/temp/hilight (echoed here)
#!/usr/bin/perl -w
use strict;

my $start_rv="\e[7m";
my $end_rv="\e[27m";

die "usage: STDIN | hilight word [words...]" if !$ARGV[0];

while(<STDIN>) {
    foreach my $arg (@ARGV) { s!$arg!$start_rv$arg$end_rv!g; }
    print;
}
they both seem to suffer from not being able to pipe the output into less and being bashisms though.

Re:Yup - already exists

Dom2 on 2004-12-16T11:01:35

less will work fine so long as you use the -R flag. Or stuff it in $LESS if you dislike specifying it every time.

-Dom

Re:Yup - already exists

Jon Dowland on 2004-12-16T11:10:20

thanks for the tip!

Leather appointed version!

Aristotle on 2004-12-17T02:28:32

Holy hell did those @- and @+ semantics ever turn my brain to mush. This was far harder than it promised to be.

#!/usr/bin/perl -w
use strict;

use Term::ANSIColor;
use List::Util qw( min );
use Getopt::Std;

getopts( 'c:' );
my @color = split /,/, our $opt_c || 'bold red';

@ARGV or die <<'END_USAGE';
usage: hl [ -c colour ] pattern [ file... ] [ < input ]
       You can use capturing parens in your pattern. In that case,
       you can supply multiple attributes separated by commas,
       which will be used to individually colour the submatches.
END_USAGE

my $rx = shift;
$rx = qr/$rx/;

while( <> ) {
    s{ $rx }{ colored_match() }gex;
    print;
}

sub colored_match {
    my $last = min( $#color, $#- );
    our( @START, @END );
    BEGIN { *START = \@-; *END = \@+; }

    if( $last ) {
        my $str = colored( substr( $_, $START[ 0 ], $START[ 1 ] ), $color[ 0 ] );
        for my $i ( 1 .. $last ) {
            $str .= colored( substr( $_, $START[ $i ], $END[ $i     ] - $START[ $i ] ), $color[ $i ] );
            $str .= colored( substr( $_, $END[ $i ], $START[ $i + 1 ] - $END[ $i ] ), $color[ 0 ] )
                unless $i == $last;
        }
        $str .= colored( substr( $_, $END[ $last ], $END[ 0 ] - $END[ $last ] ), $color[ 0 ] );
        return $str;
    }
    else {
        return colored( substr( $_, $START[ 0 ], $END[ 0 ] - $START[ 0 ] ), $color[ 0 ] );
    }
}

Re:Leather appointed version!

pudge on 2004-12-17T03:14:53

You're crazy. :-)

Re:Leather appointed version!

Aristotle on 2004-12-17T03:58:28

The good kind, I hope? :-)

Re:Leather appointed version!

wickline on 2004-12-17T04:37:29

Very very nice! I'll certainly be using this! There was an obo error in the output, but 'tis easily fixed:
--- old/hl      Thu Dec 16 23:24:27 2004
+++ bin/hl      Thu Dec 16 23:34:29 2004
@@ -29,7 +29,7 @@
     BEGIN { *START = \@-; *END = \@+; }
 
     if( $last ) {
-        my $str = colored( substr( $_, $START[ 0 ], $START[ 1 ] ), $color[ 0 ] );
+        my $str = colored( substr( $_, $START[ 0 ], $START[ 1 ] - 1 ), $color[ 0 ] );
         for my $i ( 1 .. $last ) {
             $str .= colored( substr( $_, $START[ $i ], $END[ $i     ] - $START[ $i ] ), $color[ $i ] );
             $str .= colored( substr( $_, $END[ $i ], $START[ $i + 1 ] - $END[ $i ] ), $color[ 0 ] )
-matt

Re:Leather appointed version!

Aristotle on 2004-12-17T17:52:34

Thanks, but your fix is wrong. It introduces a bug in my initial tests. Apparently neither of us tested with sufficiently diverse patterns. The real fix is:

-        my $str = colored( substr( $_, $START[ 0 ], $START[ 1 ] ), $color[ 0 ] );
+        my $str = colored( substr( $_, $START[ 0 ], $START[ 1 ] - $START[ 0 ] ), $color[ 0 ] );

Yeah, I know what you're thinking. D'oh.

At this point I realized that it almost looked like a common rather than a special case and decided that with a little work at the plumbing I could make the whole thing much simpler. I just have to append a phantom entry in @START and change $END[0] so it signifies a phantom 0th match. At this point, both special cases go away:

sub colored_match {
    my @START = @-;
    my @END = @+;
    my $last = min( $#color, $#START );

    if ( $last ) {
        push @START, $END[ 0 ];
        $END[ 0 ] = $START[ 0 ];
        my $str;
        for my $i ( 0 .. $last ) {
            $str .= colored(
                substr( $_, $START[ $i ], $END[ $i ] - $START[ $i ] ),
                $color[ $i ],
            ) unless $i == 0;
            $str .= colored(
                substr( $_, $END[ $i ], $START[ $i + 1 ] - $END[ $i ] ),
                $color[ 0 ],
            );
        }
        return $str;
    }
    else {
        return colored(
            substr( $_, $START[ 0 ], $END[ 0 ] - $START[ 0 ] ),
            $color[ 0 ],
        );
    }
}

And that can actually be understood and debugged without the aid of hallucinogenic substances.

Lesson: when semantics turn your brain to mush, change them.

Re:Leather appointed version!

wickline on 2004-12-20T00:06:37

That change didn't fix the bug I was concerned with at the time, and I started to tweak it to do so and then got involved with a bug that bugged me even more.

The bug I was concerned with initially was that extra colors should be ignored, and if insufficient colors are provided, then the uncolored captures should get the same color as the uncaptured matched text.

The bug that sidetracked me was the handling of nested matches.

I'd be curious to hear if this monstrosity correctly handled your test cases too...

-matt