#!/usr/bin/env perl

( $PROGNAME = $0 ) =~ s/.*\///;
$VERSION = "1.0";
$DEBUG = 0;

$endofcolor = qq/\033[0m/;
$default_pattern = qr/.*/;
#TODO: somehow retrieve current xterm fg and bg colors
$fgcolor = 30;
$bgcolor = 0;


sub PrintUsage
{
print <<EOHELP
$PROGNAME, version $VERSION. Reads text data from stdin and highlights specified patterns.

Usage: $PROGNAME [ [ [options] [patterns] ] [options] [patterns] ... ]

An 'option' must start with '-' and may be one of the following:
    1. -256 to enable 256 color extension of xterm.
    2. Xterm color id (see below).
    3. -i/-ni to set/unset ignorecase search.
    4. -1 to set bold font.
    5. -0 to unset bold font and/or background color.
    6. -h to print this message and exit.
Last options are remembered until they are reset with respective opposite values.
Xterm color id should range within 30..37,40..47 if 256 color xterm option is not set,
otherwise valid ids range from 0 to 255 with '.0'(fg) or '.1'(bg) suffix.
The '.0' suffix may be omitted, but notice that '-0' and '-0.0' have different meanings!

A 'pattern' should be perl compatible regular expression.

Example:

    $PROGNAME -1 -32 '\\bw.*?\\b'

highlights any word which starts with 'w' with bold green.

Xterm color map (without 256 color extension):
    Black       0;30     Dark Gray     1;30
    Blue        0;34     Light Blue    1;34
    Green       0;32     Light Green   1;32
    Cyan        0;36     Light Cyan    1;36
    Red         0;31     Light Red     1;31
    Purple      0;35     Light Purple  1;35
    Brown       0;33     Yellow        1;33
    Light Gray  0;37     White         1;37
EOHELP
}

sub ByPositions
{
    #comparison order:
    #1. start position,
    #2. start/end of the pattern flag (-1, 0 or 1)
    #3. length of the found pattern
    return $$a[ 0 ] <=> $$b[ 0 ] if $$a[ 0 ] != $$b[ 0 ];
    return $$a[ 2 ] <=> $$b[ 2 ] if $$a[ 2 ] != $$b[ 2 ];
    return - ( $$a[ 1 ] <=> $$b[ 1 ] ) if $$a[ 2 ] == 1;
    return ( $$a[ 1 ] <=> $$b[ 1 ] ) if $$a[ 2 ] == 0 || $$a[ 2 ] == -1;
}

sub PrintPosition
{
    my $Header = $_[ 0 ];
    #start position, length, start(1) or end(0) of pattern, pattern number, pattern, fg color id, bold, bg color id
    print "$Header: $$position[ 0 ], $$position[ 1 ], $$position[ 2 ], $$position[ 3 ], ${ $$position[ 4 ] }->[ 0 ], ${ $$position[ 4 ] }->[ 1 ], ${ $$position[ 4 ] }->[ 2 ], ${ $$position[ 4 ] }->[ 3 ]\n";
}


#MAIN LOOP BEGINS


#process command line arguments
while ( my $arg = shift )
{
    SWITCH_ARGS:
    {
        if ( $arg =~ /^-(.*)/ )
        {
            SWITCH_OPTS:
            {
                if ( $1 eq "h" || $1 eq "-help" || $1 eq "help" )
                {
                    PrintUsage; exit 0;
                }
                if ( $1 eq "256" )      { $enable_256_color = 1; $fgcolor = 0; last SWITCH_OPTS }
                if ( $1 eq "i" )        { $ignorecase = "i"; last SWITCH_OPTS }
                if ( $1 eq "ni" )       { $ignorecase = ""; last SWITCH_OPTS }
                if ( $1 eq "0" )        { $bold = 0; $bgcolor = 0; last SWITCH_OPTS }
                if ( $1 eq "1" )        { $bold = 1; last SWITCH_OPTS }
                if ( $enable_256_color )
                {
                    if ( $1 =~ /\d{1,3}(?=\.1)/ )   { $bgcolor = $&; last SWITCH_OPTS }
                    if ( $1 =~ /\d{1,3}(?=\.0)?/ )  { $fgcolor = $&; last SWITCH_OPTS }
                }
                else
                {
                    if ( $1 =~ /3[0-7]/ )   { $fgcolor = $&; last SWITCH_OPTS }
                    if ( $1 =~ /4[0-7]/ )   { $bgcolor = $&; last SWITCH_OPTS }
                }
            }
            last SWITCH_ARGS;
        }
        #populate pattern data
        my $bold = $::bold;
        #$bold is ever 1 if $bgcolor is set and 256 colors support is not enabled
        $bold = $bgcolor ? 1 : $bold unless $enable_256_color;
        if ( $ignorecase )
        {
            push @patterns, [ qr/$arg/i, $fgcolor, $bold, $bgcolor ];
        }
        else
        {
            push @patterns, [ qr/$arg/, $fgcolor, $bold, $bgcolor ];
        }
    }
}


#create default pattern if no one was given in command line args
if ( @patterns == 0 )
{
    push @patterns, [ $default_pattern, $fgcolor, $bold ];
}


#process STDIN line by line
while ( <> )
{
    #@positions contains the start and end positions of all found patterns in the current line
    #and other data relative to the patterns (length of found pattern, start/end_of_pattern flag,
    #pattern count number and a reference to pattern data)
    #@counts is a stack of not-ended pattern starts
    my ( @positions, @counts );

    #populate @positions
    for ( my $i = 0; $i < @patterns; ++$i )
    {
        while ( /$patterns[ $i ][ 0 ]/g )
        {
            my $found_pattern_length = length( $& );
            push @positions, (
                [ pos() - $found_pattern_length, $found_pattern_length, 1, $i, \@patterns[ $i ] ],
                [ pos, $found_pattern_length, 0, $i, \@patterns[ $i ] ] );
        }
    }

    #process @positions
    for my $position( sort ByPositions @positions )
    {
        #PrintPosition( "Pos1" );
        if ( $$position[ 2 ] )      #current start position
        {
            push @counts, [ $$position[ 3 ], $$position[ 1 ] ];
        }
        else                        #current end position
        {
            #remove first matching pattern count number from @counts
            my $found_count;
            for ( my $i = 0; $i < @counts; ++$i )
            {
                if ( $counts[ $i ][ 0 ] == $$position[ 3 ] )
                {
                    $found_count = $i;
                    last;
                }
            }
            if ( defined $found_count )
            {
                splice( @counts, $found_count, 1 );
                #end of found pattern are changed by start of a pattern
                #which corresponds to the last element in the @counts
                if ( scalar @counts )
                {
                    $$position[ 1 ] = $counts[ $#counts ][ 1 ];
                    $$position[ 2 ] = -1;   #not 1 for correct work of ByPositions()
                    $$position[ 3 ] = $counts[ $#counts ][ 0 ];
                    $$position[ 4 ] = \@patterns[ $counts[ $#counts ][ 0 ] ];
                }
            }
        }
        #PrintPosition( "Pos2" );
    }
    
    #insert color escape sequences into current line
    my $offset = 0;
    for my $position( sort ByPositions @positions )
    {
        #PrintPosition( "Pos3" );
        #no_color escape sequence
        my $color = $endofcolor;
        $color = "_$$position[ 3 ]_}" if $DEBUG;
        if ( $$position[ 2 ] )      #this position has start_of_pattern flag
        {
            #current color escape sequence
            if ( $enable_256_color )
            {
                $color = qq/\033[${ $$position[ 4 ] }->[ 2 ];38;5;${ $$position[ 4 ] }->[ 1 ]m/;
                $color .= qq/\033[${ $$position[ 4 ] }->[ 2 ];48;5;${ $$position[ 4 ] }->[ 3 ]m/ if ${ $$position[ 4 ] }->[ 3 ];
            }
            else
            {
                $color = qq/\033[${ $$position[ 4 ] }->[ 3 ];${ $$position[ 4 ] }->[ 2 ];${ $$position[ 4 ] }->[ 1 ]m/;
            }
            $color = "{_$$position[ 3 ]_" if $DEBUG;
        }
        substr( $_, $$position[ 0 ] + $offset, 0 ) = $color;
        $offset += length( $color );
    }

    #print current line
    print;
}


=head1 NAME

hl

=head1 DESCRIPTION

Reads text data from stdin and outputs it on the console with specified patterns highlighted using
xterm color escape sequences; supports 256 color xterm extension.

=head1 PREREQUISITES

None

=head1 COREQUISITES

None

=head1 README

Reads text data from stdin and outputs it on the console with specified patterns highlighted using
xterm color escape sequences; supports 256 color xterm extension.

=pod OSNAMES

Any, color xterm

=pod SCRIPT CATEGORIES

Search

=head1 Author

Alexey Radkov <raks@inbox.ru> 

=head1 HISTORY

1. 2006/01/16 - Version 1.0

=cut