#!/usr/bin/perl
#
# GPLv2 : http://www.gnu.org/licenses/old-licenses/gpl-2.0.html
# Author : Benoit Peccatte
#
use strict;
use warnings;
use Term::ANSIColor;
use Regexp::Parser;

if(scalar(@ARGV) != 2) {
	print "Usage $0 <regex> <string>\n";
	print "  You can use '-' for <regex> or <string> to loop on stdin\n";
	exit 1;
}

# ugly but simple
my @pos1;
my @pos2;

# main
if($ARGV[0] eq "-") {
	while(<STDIN>) {
		chomp;
		run (qr/$_/, $ARGV[1]);
	}
} elsif($ARGV[1] eq "-") {
	while(<STDIN>) {
		chomp;
		run ($ARGV[0], $_);
	}
} else {
	run($ARGV[0], $ARGV[1]);
}
exit;

# run the test on one regex and one string
sub run
{
	my ($regex, $string) = @_;
	my $parser = Regexp::Parser->new;
	$parser->parse($regex);
	my $prefix = "";
	for my $n (@{$parser->root}) {
		regtest($prefix, $n, $string);
		$prefix .= $n->visual;
	}
	printmatch($string);
}

# recursively test a parsed regex node on a given string
sub regtest
{
	my ($prefix, $node, $string) = @_;
	return if ref($node) eq "";
	my $p = $prefix;
	if(ref($node->{data}) eq "ARRAY" && 
		$node->{family} ne "anyof") { # avoid digging into [...]
		for my $n (@{$node->{data}}) {
			next if (ref($n) !~ "Regexp::Parser::");
			regtest($p, $n, $string);
			$p .= $n->visual;
		}
	}

	my $re = $prefix.$node->visual;
	if( $string =~ /$re/ ) {
		print "$`".colored("$&", 'red')."$' : $re\n";
		@pos1 = @-;
		@pos2 = @+;
	} else {
		print "$string : $re\n";
	}
}

# print and format results of a match
sub printmatch 
{
	my ($string) = @_;
	my $len = length($string);
	for(my $i=1; $i<scalar(@pos1); $i++) {
		my $s = substr($string,$pos1[$i], $pos2[$i]-$pos1[$i]);
		print " "x$pos1[$i] . $s . " "x($len-$pos2[$i]) . " : \$$i\n";
	}
}