#!/usr/bin/perl -w

use strict;
use warnings;

unless (@ARGV) {
	die "Usage: syntaxcorrect <directory> [--autofix]\n"
		. "Same as syntaxcheck, but it prompts you to correct errors.\n"
		. "If you've run this before, your fixes are saved to syntaxcorrect.last; \n"
		. "if you run this again with --autofix, your fixes will be automatically\n"
		. "applied (e.g. rebuild from aiml2rs and run this and your fixes from before\n"
		. "are applied again!)\n";
}

print "aiml2rs syntax correcting utility\n\n"
	. "For each syntax error found in the RiveScript code, you'll have the\n"
	. "opportunity to correct the error by typing the correct version of\n"
	. "the line displayed. If the line is not an error, simply hit enter to\n"
	. "keep it the same.\n\n";

# This script does the same as syntaxcheck but prompts the user to correct
# each mistake. To make it easier, it can record each syntax error and remember
# your choice, so if you rebuild the RS code and rerun this script, it will
# automatically fix the mistakes.
use Data::Dumper;
my $fixes = {};
if (-f "./syntaxcorrect.last") {
	$fixes = do "./syntaxcorrect.last";
}
my $autofix = 0;
if (defined $ARGV[1] && $ARGV[1] =~ /autofix/i) {
	print "Mistakes will automatically be fixed per your last entry.\n\n";
	$autofix = 1;
}

opendir (DIR, $ARGV[0]);
foreach my $file (sort(grep(/\.rs$/i, readdir(DIR)))) {
	open (READ, "$ARGV[0]/$file");
	my @in = <READ>;
	chomp @in;
	close (READ);
	my @out = ();

	my $line = 0;
	my $previous = '';
	my $next = '';
	for (my $i = 0; $i < scalar(@in); $i++) {
		$_ = $in[$i];
		if ($i > 0) {
			$previous = $in[$i-1];
		}
		if ($i < scalar(@in)) {
			$next = $in[$i+1];
		}

		$line++;
		my @chars = split(//, $_);
		my $curly  = 0; # {}
		my $angled = 0; # <>
		foreach my $c (@chars) {
			$curly++ if $c eq '{';
			$curly-- if $c eq '}';

			$angled++ if $c eq '<';
			$angled-- if $c eq '>';
		}

		# Warnings?
		my $warning = '';
		if ($curly > 0) {
			$warning .= "Unmatched left curly bracket; ";
		}
		if ($curly < 0) {
			$warning .= "Unmatched right curly bracket; ";
		}
		if ($angled > 0) {
			$warning .= "Unmatched left chevron; ";
		}
		if ($angled < 0) {
			$warning .= "Unmatched right chevron; ";
		}

		if (length $warning) {
			print "\tWarning: $warning at $file line $line\n"
				. "\t        " . ($line-1) . ":  $previous\n"
				. "\tHERE--> $line:  $_\n"
				. "\t        " . ($line+1) . ":  $next\n";

			# Did we fix this line already?
			if (exists $fixes->{$_}) {
				print "This line has been corrected before.\n"
					. "new line>  $fixes->{$_}\n\n";
				$_ = $fixes->{$_};
			}
			else {
				print "Correct this line or <Return> to keep it how it is.\n"
					. "new line>  ";
				while (1) {
					my $replace = <STDIN>;
					chomp $replace;
					if (length $replace) {
						if ($replace =~ /^[A-Za-z0-9]/) {
							print "!!! Remember to begin your line with the proper RS command !!!\n";
							next;
						}
						$fixes->{$_} = $replace;
						$_ = $replace;
						last;
					}
					else {
						$fixes->{$_} = $_;
						last;
					}
				}
			}
		}

		push (@out, $_);
	}

	open (WRITE, ">$ARGV[0]/$file");
	print WRITE join("\n",@out);
	close (WRITE);
}
closedir (DIR);

# Save their fixes
open (FIX, ">syntaxcorrect.last");
print FIX Dumper($fixes);
close (FIX);
print "Fixes saved to syntaxcorrect.last\n";