#!/usr/bin/env perl
#
# A simple filter program to decorate patterns with ANSI escape sequences.
# Released under the MIT license
#
# Author: Dave Goodell <davidjgoodell@gmail.com>
#
# With contributions from:
# - Scott Baker <scott@perturb.org>

use strict;
use warnings;
use v5.16;
use Getopt::Long;

# Disable output buffering
*STDOUT->autoflush;

my $VERSION = "v1.8.5";

my $ignore_case      = 1;
my $case_sensitive   = undef;
my $case_insensitive = undef;
my $debug            = 0;
my @raw_filters      = ();
my $force            = 0;
my $full_match       = 0;
my $bold             = 0;
my $file;
my $color;

GetOptions(
	"case_sensitive|s"   => \$case_sensitive,
	"case_insensitive|i" => \$case_insensitive,
	"help"               => \&print_usage_and_exit,
	"filter|f=s"         => \@raw_filters,
	"debug"              => \$debug,
	# Force colorization on at *ALL* times
	"force"              => \$force,
	# Highlight full matches not just captured parens
	"full_matches"       => \$full_match,
	"file=s"             => \$file,
	"bold"               => \$bold,
) or die "unable to parse options, stopped";

if ($case_sensitive) {
	$ignore_case = 0;
} elsif ($case_insensitive) {
	$ignore_case = 1;
}

my @def_colors    = (33,11,9,47,214,99,15,51,198,94); # Blue, Yellow, Red, Green, Orange, Purple, White, LightBlue, Magenta, Brown
my $def_color_num = 0;
my $reset         = color('reset');

# If the user requests bold for colors we output in bold
if ($bold) {
	$bold = color('bold');
} else {
	$bold = "";
}

# Respect manual color overrides in ENV
if ($ENV{"HIGHLIGHT_COLORS"}) {
	@def_colors = split(/,/,$ENV{"HIGHLIGHT_COLORS"});
}

# @colors contains raw ANSI escape sequences
my (@colors,@filters);

if ($file) {
	my $ok = read_patterns_from_file($file, \@ARGV, \@raw_filters);
}

# These are "--filter foo --filter bar" type of options
if (@raw_filters) {
	# Build all the filter/color pairs
	foreach my $f (@raw_filters) {
		my ($filter,$color);

		# If there is a comma it's a filter/color pair
		if ($f =~ /(.+?),(.*)/) {
			$color  = $1;
			$filter = $2;
		# It's just a bare word, so it gets the default color
		} else {
			$filter = $f;

			# Get the next color in the color array
			my $index_num = $def_color_num++ % scalar(@def_colors);
			$color        = $def_colors[$index_num];
		}

		push(@colors,$color);
		push(@filters,$filter);
	}
}

# These are bareword options: highlight foo bar
foreach my $filter (@ARGV) {
	# Get the next color in the array
	my $index_num = $def_color_num++ % scalar(@def_colors);
	$color        = $def_colors[$index_num];

	push(@colors,$color);
	push(@filters,$filter);
}

# If we're in debug mode we print out the words and colors before we do
# any highlighting
if ($debug) {
	my $length = longest_word(@filters);
	$length   += 2; # We add two because we '' the filter below and it makes the string longer

	for (my $i = 0; $i < @filters; $i++) {
		my $color  = $colors[$i];
		my $filter = $filters[$i];

		my $c = $bold . color($color);
		printf("Filter: $c%${length}s$reset = '$color'\n", "'$filter'");
	}

	print "\n";
}

# Ensure we have at least ONE thing to filter on
if (!@ARGV && !@filters) {
	print_usage();
	die("At least one pattern required to match\n");
}

#############################################################################
# Everything above is setting up the filters and the appropriate colors
# Everything below is actually doing to search/replace and coloring
#############################################################################

# Go line by line and apply each filter to it
while (my $line = <STDIN>) {

	# Loop through each filter
	for (my $i = 0; $i < @filters; $i++) {
		my $filter    = $filters[$i];
		my $color_raw = $colors[$i];
		my $color_str = $bold . color($color_raw);

		# If we're not FORCING CaseInsensitive or CaseSensitive then we do SmartCase
		if (!defined($case_sensitive) && !defined($case_insensitive)) {
			$ignore_case = int(!has_uppercase($filter));
		}

		# Search for the filter and wrap it in color
		# Prepend an ANSI-skip branch so filters never match digits inside
		# existing escape sequences (e.g. filter "22" hitting "228" in \e[38;5;228m).
		# (*SKIP) prevents backtracking into the ANSI sequence, (*FAIL) rejects the
		# match, and | makes the filter pattern the fallback on real text.
		if ($ignore_case) {
			$filter = qr/\e\[[\d;]*m(*SKIP)(*FAIL)|$filter/i;
		} else {
			$filter = qr/\e\[[\d;]*m(*SKIP)(*FAIL)|$filter/;
		}

		$line = colorize_line($line, $filter, $color_str);
	}

	print $line;
}

##########################################################################

sub print_usage {
	my $ver_str = color('47', $VERSION);
	my $color = color('230');
	my $reset = color('reset');

    print <<EOT;
This is highlight version $ver_str.

Usage: $0 <PATTERN0> [PATTERN1...]
  or
Usage: $0 [--filter COLOR,PATTERN] [--filter COLOR,PATTERN] ...
$color
--bold                  output matched patterns using bold font
--case_insensitive, -i  pattern matching is not case sensitive (default)
--case_sensitive, -s    pattern matching is case sensitive
--file                  read patterns from a file
--filter, -f            a color and pattern pair (separated by a comma)
--force                 force coloring on, even when not connected to a terminal
--full_matches          colorize entire match, not just captured parens
--help                  show command usage
$reset
This program takes text via standard input and outputs it with the given
regexp patterns highlighted in color.  If no color option
is specified, it defaults to a pre-selected array of colors.

Using --case_sensitive will enable case-sensitive matching. Otherwise
Vim style smartcase matching will be utilized.

If your match pattern begins with a dash, you will have to use the --filter
syntax so highlight can differentiate between a filter and a param.

EOT
}

sub print_usage_and_exit {
	print_usage();
	exit 0;
}

# String is 100% numeric
sub is_numeric {
	my $f = shift();
	if ($f =~ /^(\d+\.?\d*|\.\d+)$/) { return 1; }

	return 0;
}

# String contains ANY uppercase
sub has_uppercase {
	my $str = shift();
	my $ret = 0;

	if ($str =~ /[A-Z]/) {
		$ret = 1;
	}

	return $ret;
}

# Find the length of the longest word in an array
sub longest_word {
	my @arr     = @_;
	my $longest = 0;

	foreach my $word (@arr) {
		my $len = length($word);

		if ($len > $longest) {
			$longest = $len;
		}
	}

	return $longest;
}

sub colorize_line {
	my ($line, $filter, $color) = @_;

	# This is an *eval* search/replace
	#
	# We look for matches in the line and pass the search/replace logic to
	# a separate function to handle the colorization
	$line =~ s/$filter/colorize_matches($&, $filter, $color, @{^CAPTURE})/eg;

	return $line;
}

sub get_captures {
    no strict 'refs';

    my $last_idx = scalar(@-) - 1;
    my @arr      = 1 .. $last_idx;
    my @ret      = map { $$_; } @arr;

    return @ret;
}

sub colorize_matches {
	my ($str, $pattern, $color, @captures) = @_;

	my $ret = $str;

	# Perl's prior to 5.25.7 did not have @{^CAPTURE} so we have to work
	# around for the lack of this variable
	#
	# https://perldoc.perl.org/variables/@-
	if (!@captures && @-) {
		@captures = get_captures();
	}

	# If there are @captures that means there are ( parens ) so we only
	# colorize the words INSIDE the parens
	if (!$full_match && @captures) {
		foreach my $captured_text (@captures) {
			$ret =~ s/$captured_text/$color$&$reset/ig;
		}
	# Otherwize it's a normal match and we colorize the entire match
	} elsif ($str) {
		$ret = $color . $str . $reset;
	}

	return $ret;
}

# String format: '115', '165_bold', '10_on_140', 'reset', 'on_173', 'red', 'white_on_blue'
sub color {
	my ($str, $txt) = @_;

	if (!$force && (-t STDOUT == 0 || $ENV{NO_COLOR})) { return $txt // ""; }
	if (!length($str)  || $str eq 'reset') { return "\e[0m";    } # No string = RESET

	# Some predefined colors/commands
	state %color_map = qw(red 160 blue 27 green 34 yellow 226 orange 214 purple 93 white 15 black 0);
	state %cmd_map   = qw(bold 1 italic 3 underline 4 blink 5 inverse 7);

	# Pre-process the string
	$str =~ s/on_/-/g;                             # "on_" becomes a negative number
	$str =~ s|([A-Za-z]+)|$color_map{$1} // $1|eg; # color name -> number

	my @parts = map { # If it's negative it's a background color, otherwise foreground
		$cmd_map{$_} // ($_ =~ /^-(.+)/ ? get_ansi_color($1, 48) : get_ansi_color($_, 38))
	} split("_", $str);

	my $ret = "\e[" . join(";", @parts) . "m";

	if (defined $txt) { $ret .= $txt . "\e[0m"; }

	return $ret;
}

sub get_ansi_color {
	my ($str, $mode) = @_;

	if ($str =~ m/#(\w{6})/) {
		my ($r,$g,$b) = unpack('C3', (pack 'H6', $1));
		return "$mode;2;$r;$g;$b";
	} else {
		return "$mode;5;$str";
	}
}

sub trim {
	my ($s) = (@_, $_); # Passed in var, or default to $_
	if (!defined($s) || length($s) == 0) { return ""; }
	$s =~ s/^\s*//;
	$s =~ s/\s*$//;

	return $s;
}

sub file_get_contents {
	open (my $fh, "<", $_[0]) or return undef;

	if ($_[1]) { # Line mode
		return my @lines  = readline($fh);
	} else {     # String mode
		local $/ = undef; # Input rec separator (slurp)
		return my $ret  = readline($fh);
	}
}

# Read patterns from file... one entry per line
# Advanced filters can be specified by using a tab separator
#
# Example of simple filters:
# cat
# dog
# horse
#
# Example of complex filters (tab separated):
# red		file: (\w+)
# 17		foo.*bar
# 99		pattern[s\d]
sub read_patterns_from_file {
	my ($file, $simple_filters, $adv_filters) = @_;

	if (!-r $file) {
		return 0;
	}

	# Get the lines from the file
	my @lines = file_get_contents($file, 1);
	foreach (@lines) {
		$_ = trim($_);
	}

	@lines = reverse(@lines);

	foreach my $line (@lines) {
		# If the line is a comment, skip it
		if ($line =~ /^#/) {
			next;
		}

		my @parts = split(/\t+/, $line, 2);

		# Color is the first column, and pattern is the second
		my $color   = $parts[0] || "";
		my $pattern = $parts[1] || "";

		# If there is not a pattern it's a one column entry which is only pattern
		if (!$pattern) {
			$pattern = $color;
			$color   = "";
		}

		# Advanced filter: color => pattern
		# We use len here because "0" may be a valid color
		if ((length($color) > 0) && $pattern) {
			if ($debug) {
				print "Adding advanced: $color => $pattern\n";
			}

			unshift(@$adv_filters, "$color,$pattern");
		# Simple filter: pattern
		} elsif ($pattern) {
			if ($debug) {
				print "Adding regular: $pattern\n";
			}

			unshift(@$simple_filters, $pattern);
		}
	}

	return 1;
}

# Debug print variable using either Data::Dump::Color (preferred) or Data::Dumper
# Creates methods k() and kd() to print, and print & die respectively
BEGIN {
	if (eval { require Data::Dump::Color }) {
		*k = sub { Data::Dump::Color::dd(@_) };
	} else {
		require Data::Dumper;
		*k = sub { print Data::Dumper::Dumper(\@_) };
	}

	sub kd {
		k(@_);

		printf("Died at %2\$s line #%3\$s\n",caller());
		exit(15);
	}
}

# vim: tabstop=4 shiftwidth=4 autoindent softtabstop=4
