#!/usr/bin/perl -w
use strict;
#
# Read a board and a (possibly wrong) partial solution and find the mistakes.
# Solves the board, then compares with the partial solution and
# says what mismatched.
#
my $board_name;
my $partial_name;
my $debug = 0;

sub dbprint($) {
    my ($str) = @_;
    if ($debug) { print $str; }
}

# ****************************************************************
# Process arguments

while ($_ = shift) {
    my $arg = $_;
    if ($arg =~ /^-debug/) {
	$debug = 1;
    } elsif ($arg eq "-board") {
	$board_name = shift;
    } elsif ($arg eq "-solution") {
	$partial_name = shift;
    } else {
	die "Argument $arg not understood";
    }
}

# ****************************************************************
# ****************************************************************
# Read the board

open BD, "<$board_name" or die "Can't open input board $board_name";

my $line_no = 1;
my @vals = ();
while (<BD>) {
    my $line = $_;
    if ($debug) { print "Read board line '${line}'\n"; }
    if ($line !~ /^\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])/) {
	next;
    }
    if ($debug) { 
	print "Matched line; read values $1,$2,$3,$4,$5,$6,$7,$8,$9\n";
    }
    push @vals, $1,$2,$3,$4,$5,$6,$7,$8,$9;
    $line_no++;
    if ($line_no > 9) { last; }
}
if (scalar(@vals) < 81) {
    my $vc = scalar(@vals);
    die "Didn't find enough values:  found $vc\n";
}

close BD or die "Error closing input board";

open SLN, "<$partial_name" or die "Can't open partial partial";
$line_no = 1;
my @partial = ();
while (<SLN>) {
    my $line = $_;
    if ($debug) { print "Read partial line '${line}'\n"; }
    if ($line !~ /^\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])\s*([0-9-])/) {
	next;
    }
    if ($debug) { 
	print "Matched line; read values $1,$2,$3,$4,$5,$6,$7,$8,$9\n";
    }
    push @partial, $1,$2,$3,$4,$5,$6,$7,$8,$9;
    $line_no++;
    if ($line_no > 9) { last; }
}
if (scalar(@partial) < 81) {
    my $vc = scalar(@partial);
    die "Didn't find enough values:  found $vc\n";
}
close SLN or die "Error closing the blank pattern file";

my $soln_text = `solve_sudoku $board_name -silent`;
##if ($debug) { print "Solution text:\n $soln_text"; }
my @split_text = split /\n/, $soln_text;
my $solution_count = 0;
my $lnno = 0;
my $bad;
my @solution = ();
my $reading_solution = 0;
my $solution_line = 0;
foreach my $ln (@split_text) {
    $lnno++;
    if ($reading_solution && $ln =~ /\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])\s*([1-9])/) {
	push @solution, $1,$2,$3,$4,$5,$6,$7,$8,$9;
	$solution_line++;
	if ($solution_line >= 9) {
	    $solution_line = 0;
	    $reading_solution = 0;
	}
    }

    # Don't scan the part after the second solution looking for solutions.
    if ($solution_count < 2) {
	if ($ln =~ /No solution\!/) {
	    die "Found 'No solution' line -- board is no good\n";
	} elsif (!$solution_count && $ln =~ /Botch/) {
	    die "Found 'Botch' line -- board is no good\n";
	} elsif (!$solution_count && $ln =~ /Jammed/) {
	    dbprint "Found 'Jammed' line -- board is probably no good\n";
	    $bad = 1;
	    next;
	} elsif ($ln =~ /^Solution:/) {
	    print "Found a solution...\n";
	    if ($solution_count) {
		print "Found more than one solution";
		exit;
	    }
	    $bad = 0;
	    $solution_count++;
	    dbprint "Located first solution at line $lnno\n";
	    $reading_solution = 1;
	} elsif ($ln =~ /SECOND.*solution:/) {
	    $solution_count++;
	    die "Located second solution at line $lnno\n";
	}
    }
}

if (scalar(@solution) != 81) {
    my $ssz = scalar(@solution);
    die "Solution size is wrong: $ssz\n";
}

if ($solution_count != 1) {
    die "Failed to find exactly one solution\n";
}

foreach my $i (0..$#solution) {
    my $user_val = $partial[$i];
    my $sval = $solution[$i];
    if ($user_val eq "0" || $user_val eq "-") { next; }
    if ($user_val ne $sval) {
	print "ERROR: entry $i = $user_val is wrong\n";
	if ($debug) {
	    print " .. should have been $sval\n";
	}
    }
}