Stories
Slash Boxes
Comments
NOTE: use Perl; is on undef hiatus. You can read content, but you can't post it. More info will be forthcoming forthcomingly.

All the Perl that's Practical to Extract and Report

use Perl Log In

Log In

[ Create a new account ]

pudge (1)

pudge
  (email not shown publicly)
http://pudge.net/
AOL IM: Crimethnk (Add Buddy, Send Message)

I run this joint, see?

Journal of pudge (1)

Wednesday December 15, 2004
06:00 PM

Highlight

[ #22326 ]

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.

The Fine Print: The following comments are owned by whoever posted them. We are not responsible for them in any way.
 Full
 Abbreviated
 Hidden
More | Login | Reply
Loading... please wait.
  • 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...

  • Or you can use: alias grep="grep --color"
  • And with Term::ANSIColor [perladvent.org] you don't even have to remember or look up what the code for red is :-)

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

    • Yes, that's perfectly good, and to extend this in any significant direction, that would be the way to go.
    • 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.

      • 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;
        }

      • 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;
  • ..but I don't blame you for not finding it :) http://www.alcopop.org/temp/hilight [alcopop.org] (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.

  • 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 sep

    • 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[

      • 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

        • 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 [perl.org] correctly handled your test cases too..