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

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.
  • 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 ] );
        }
    }
    • 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..