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 ]

wickline (135)

wickline
  (email not shown publicly)

Journal of wickline (135)

Sunday December 19, 2004
07:02 PM

a colorful waste of time

[ #22374 ]

It's Pudge's fault, no it's Aristotle's fault. OK, I guess it's really my own fault. I spent a silly amount of time getting the hilight script to handle nested parens in a fashion which didn't bug me...

I'll be curious to hear if it handles all of Aristotle's favorite test cases too.

-matt

#!/usr/bin/perl -wnp
 
use strict;
use Term::ANSIColor;
use Getopt::Std;
 
our( @COLOR, $REGULAR_EXPRESSION, $LINE_NUMBER, $NUM_MATCHES, @START, @END, @PROCESSED );
 
use constant ENTIRE_MATCH => 0;
 
BEGIN {
    getopts( 'c:' ) && @ARGV or die <<"    END_USAGE";
usage: $0 [ -c color ] pattern [ file... ] [ < input ]
    You can use capturing parens in your pattern.
    If you provide multiple atrributes via the -c option,
    the first will be used to color the portion matching
    the pattern, the second will color the portion matching
    the first capturing parens, the third will color the
    portion matching the second capturing parens, etc.
    Extra colors will be ignored. Extra parens will be
    colored the same as the non-captured matching text.
 
    % cat notes.txt
financial notes...
\$25 I owed to "bob smith" on 20041211 explanation: brewfest  # some meta data here
\$1 I paid to "sally johnson" on 20041212 explanation: sodas  # some meta data here
\$25 I paid to "bob smith" on 20041213 explanation: cash      # some meta data here
\$1 I recd from "sally johnson" on 20041215
\$42 I paid to "" on 200412157 explanation: top secret xmass
other notes...
\$100_000_000_000 might be nice to have, eh?
I wonder what I'm doing on tuesday next week.
I like pie.
    % $0  \\
    -c'cyan,  bold, red,   green, yellow,       magenta,    blue,  white on_red, bold    '  \\
       '\\\$\\d+ (I (?:(owed)|(paid)|(recd)) \\S+) "([^"]*)" on (\\d+) *(explanation: (.+))?#?'  \\
       < notes.txt
    END_USAGE
    # yes the above looks ugly, but it prints out a tidy usage example
 
    @COLOR = split /,/, our $opt_c || 'bold red';
    $REGULAR_EXPRESSION = qr/@{[ shift ]}/;
}
 
s{ $REGULAR_EXPRESSION }{  paint_match( ENTIRE_MATCH )  }gsex;
 
sub init_match_info {
    return unless $. > ( $LINE_NUMBER || 0 );
    $LINE_NUMBER = $.;
    @START       = @-;
    @END         = @+;
    $NUM_MATCHES = $#END;
    @PROCESSED   = ();
}
 
sub paint_match {
    init_match_info();
 
    my $match = shift;
    return $_ if $match > $NUM_MATCHES;
 
    my( $result, $cursor ) = ( '', $START[ $match ] );
 
    for my $nested_match (  $match + 1  ..  $NUM_MATCHES  ) {
        next if empty( $nested_match ) || $PROCESSED[ $nested_match ];;
        last unless match_x_contains_match_y( $match, $nested_match );
 
        $result .= paint_substr(  $cursor,  $START[ $nested_match ],  $match  );
        $result .= paint_match(  $nested_match  );
 
        $cursor = $END[ $#PROCESSED ];
    }
 
    $result .= paint_substr(  $cursor,  $END[ $match ],  $match  );
    $PROCESSED[ $match ]++;
    return $result;
}
 
sub paint_substr {
    my( $start, $end, $match ) = @_;
    return '' unless $end > $start;
    return colored(  substr( $_, $start, $end - $start ),  colors_for_match( $match )  );
}
 
sub empty{  ! $END[ shift() ]  }
 
sub match_x_contains_match_y {
    my( $x, $y ) = @_;
    return(
        ! empty( $x )
        and
        $END[ $x ] > $START[ $y ]
        and
        $START[ $x ] <= $END[ $y ]
    );
}
 
sub colors_for_match {
    my $match = shift;
    return $COLOR[ ENTIRE_MATCH ]
        if (  $match == ENTIRE_MATCH  or  ! $COLOR[ $match ]  );
    return map {
        match_x_contains_match_y( $_, $match)  ? $COLOR[ $_ ]  : ();
    } ENTIRE_MATCH .. $match;
}

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.
  • You know how google always colors cached pages a certain way? Well it might be nice if this script did the same...

    instead of
        @COLOR = split /,/, our $opt_c || 'bold red';
    maybe
        @COLOR = split /,/, our $opt_c || $ENV{HILIGHT_COLORS} || 'bold red';
    -matt
  • Just so you know, I haven’t forgotten this. It’s just that my mills grind slowly, and sometimes very, very slowly…