Beefy Boxes and Bandwidth Generously Provided by pair Networks
good chemistry is complicated,
and a little bit messy -LW
 
PerlMonks  

Input highlighter / visual grep

by Aristotle (Chancellor)
on Dec 17, 2004 at 02:40 UTC ( #415533=sourcecode: print w/ replies, xml ) Need Help??

Category: Utility Scripts
Author/Contact Info /msg Aristotle
Description:

Inspired by pudge over at use.perl, here's a short little script you can use to highlight pattern matches in input data.

usage: hl [ -c colour ] [ -x ] 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.

-x will supress lines without matches.

Update: fixed massive offset calculation bug, hugely simplified the colourizing routine.

Due to the semantics of the @- and @+ arrays, my first stab was a horrible monster and incredibly difficult to debug, far harder to write than it promised to be. The special entries at index 0 indicating the start and end of the entire match required terrible contortions to take into account.

And, surprise surprise, the code was buggy.

In fixing my bug, I realized that the proper special case looked almost like a common case. And then I realized that by appending a phantom zero-length match and changing index 0 to instead signify a phantom zero-length 0th match, both special cases disappear.

Lesson: when implementing the semantics turns your brain to mush, change the semantics.

For a history of the code, look at aforementioned use.perl thread.

#!/usr/bin/perl
use strict;
use warnings;

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

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

@ARGV or die <<"END_USAGE";
usage: @{[ colored( 'hl [ -c colour ] [ -x ] pattern [ file... ] [ < i
+nput ]', 'bold' ) ]}
       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.
       @{[ colored( '-x', 'bold' ) ]} will supress lines without match
+es.
END_USAGE

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

while ( <> ) {
    s{ $rx }{ colored_match() }gex or not( our $opt_x ) or next;
    print;
}

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

    if ( $last ) {
        push @START, $END[ 0 ];
        push @END, $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 ],
        );
    }
}

Comment on Input highlighter / visual grep
Download Code

Back to Code Catacombs

Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: sourcecode [id://415533]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others musing on the Monastery: (3)
As of 2015-07-04 01:06 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









    Results (57 votes), past polls