#! /usr/bin/perl -w

# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
# This program is distributed with GNU Go, a Go program.            #
#                                                                   #
# Write gnugo@gnu.org or see http://www.gnu.org/software/gnugo/     #
# for more information.                                             #
#                                                                   #
# Copyright 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007    #
# 2008 and 2009 by the Free Software Foundation.                    #
#                                                                   #
# This program is free software; you can redistribute it and/or     #
# modify it under the terms of the GNU General Public License       #
# as published by the Free Software Foundation - version 3,         #
# or (at your option) any later version.                            #
#                                                                   #
# This program is distributed in the hope that it will be           #
# useful, but WITHOUT ANY WARRANTY; without even the implied        #
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR           #
# PURPOSE.  See the GNU General Public License in file COPYING      #
# for more details.                                                 #
#                                                                   #
# You should have received a copy of the GNU General Public         #
# License along with this program; if not, write to the Free        #
# Software Foundation, Inc., 51 Franklin Street, Fifth Floor,       #
# Boston, MA 02111, USA.                                            #
# # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # # #
#
# matcher_check info:
#
# Plays one gtp program against itself or lets it analzye a saved .sgf-file,
# and watches for bad status transitions.
#
# FIXME: if the vertex by which a dragon is named ever changes,
# the hash table used will consider it new.  therefore, if the
# vertex changes at the same time an illegal state change occurs,
# it will get missed.  Also, it is possible that a dragon would
# be captured, and that vertex go unused until a new piece was
# played in that spot, resulting in a false positive.  However,
# this should be rare (?).

package TWOGTP_A;

use IPC::Open2;
use Getopt::Long;
use FileHandle;
use strict;
use warnings;
use Carp;

STDOUT->autoflush(1);

#following added globally to allow "use strict" :
my $vertex;
my $first;
my $sgfmove;
my $sgffilename;
my $pidp;
my $sgffile;
my $handicap_stones;
my $result;
my @vertices;
my $second;
my %game_list;
#end of "use strict" repairs

my $program;
my $size = 19;
my $verbose = 0;
my $komi = 5.5;
my $handicap = 0;
my $games = 1;
my $wanthelp;

#added for matcher_check
my %match_hist;
my $loadfile;
my $movenum;
my $movecount;
my $move;
my $toplay;
my $randseed;
my $stable;
my $pids;
my $stable_move = "";
my $noilcheck;
my $color;

my $helpstring = "

Run with:

matchercheck --program \'<path to program> --mode gtp [program options]\' \\
       [matcher_check options]

Possible matcher_check options:

  --verbose 1 (to list moves) or --verbose 2 (to draw board)
  --komi <amount>
  --handicap <amount>
  --size <board size>                     (default 19)
  --games <number of games to play>       (-1 to play forever)
  --sgffile <filename>			  (file to save games as)
  --loadsgf <filename>			  (file to analyze)
  --movecount <number of moves to check>
  --randseed <number>			  (sets the random seed)
  --stable \'<path to stable version> --mode gtp [program options]\'
  --noilcheck				  (turns off illegal transition checks)
  --color <color>		          (only replay for color; has no effect
  					   without --noilcheck and --loadsgf)
  --help                                  (show this)


";

GetOptions(
           "program|p=s"            => \$program,
           "verbose|v=i"            => \$verbose,
           "komi|k=f"               => \$komi,
           "handicap|h=i"           => \$handicap,
           "size|boardsize|s=i"     => \$size,
           "sgffile|o=s"            => \$sgffilename,
	   "loadsgf|l=s"	    => \$loadfile,
           "games=i"                => \$games,
	   "movecount=i"	    => \$movecount,
	   "randseed=i"		    => \$randseed,
	   "stable=s"		    => \$stable,
	   "noilcheck"		    => \$noilcheck,
	   "color=s"		    => \$color,
           "help"                   => \$wanthelp,
);

if ($wanthelp) {
    print $helpstring;
    exit;
}


if (!$program) {
    $program = '../gnugo --mode gtp --quiet';
    warn "Defaulting program to: $program\n";
}

if (defined($color) and (!defined($noilcheck) or !defined($loadfile))) {
    print "Error: --color requires --noilcheck and --loadsgf";
    exit;
}


# create FileHandles
my $prog_in  = new FileHandle;		# stdin of program
my $prog_out = new FileHandle;		# stdout of program
my $stable_in  = new FileHandle;	# stdin of stable version
my $stable_out = new FileHandle;	# stdout of stable version


if ($loadfile)
{
    #we need to analyze an sgf file
    if (not defined $movecount) {
	print "Error: When analyzing an sgf file with --loadsgf <filename>, you also need to
specify the number of moves to check with --movecount <n>.
";
	exit;
    }

    $pidp = open2($prog_out, $prog_in, $program);
    $pids = open2($stable_out, $stable_in, $stable) if defined($stable);
    print "program pid: $pidp\n" if $verbose;
    print "stable pid:  $pids\n" if (defined($stable) and $verbose);

    if (defined($randseed)) {
        print $prog_in "set_random_seed $randseed\n";
	eat_no_response($prog_out);
    } else {
        print $prog_in "get_random_seed\n";
        $randseed = eat_one_line($prog_out);
        print "random seed $randseed\n";
    }

    if (defined($stable)) {
        $randseed =~ s/^= //smg;
        print $stable_in "set_random_seed $randseed\n";
        eat_no_response($stable_out);
    }

    for ($movenum = 1; $movenum <= $movecount + 1; $movenum++)
    {
        #load the file, check the statuses, next move.
        my $lmove = $movenum + 1;#number to load up to
	print "loading move $movenum\n" if $verbose;
        print $prog_in "loadsgf $loadfile $lmove\n";
	eat_no_response($prog_out);
        if (!defined($noilcheck)) {
            check_matcher($prog_in, $prog_out);
            print "done checking status.\n" if ($verbose);
        }

        #do stable checks
        if (defined($stable)) {
            print $stable_in "loadsgf $loadfile $lmove\n";
            $toplay = eat_one_line($stable_out);
            $toplay =~ s/^=//smg;
            $toplay =~ s/ //smg;
	    if (!defined($color) or ($color eq $toplay)) {
		print $prog_in "genmove_$toplay\n";
		print $stable_in "genmove_$toplay\n";
		$move = eat_move($prog_out);
		$stable_move = eat_move($stable_out);
		if ($move ne $stable_move and defined ($stable)) {
		    print "At move $movenum, $toplay\:\n";
		    print "Test version played   $move\n";
		    print "Stable version played $stable_move\n";
		    if ($verbose eq 2) {
			print $prog_in "showboard\n";
			print eat_response($prog_out);
		    }
		} else {
		    print "$toplay plays $move\n" if $verbose;
		}
	    }
        }
    }

    print "done reading sgf file\n" if ($verbose);
    exit;
}


while ($games > 0) {
    %match_hist = ();
    $pidp = open2($prog_out, $prog_in, $program);
    print "program pid: $pidp\n" if $verbose;

    if (defined($stable)) {
        $pids = open2($stable_out, $stable_in, $stable);
        print "stable pid: $pids\n" if $verbose;
    }

    $sgffile = rename_sgffile($games, $sgffilename) if defined $sgffilename;

    if ((defined $sgffilename) && !open(SGFFILEHANDLE, ">$sgffile")) {
	printf("can't open $sgffile\n");
	undef($sgffilename);
    }

    #set autoflushing for sgf file
    SGFFILEHANDLE->autoflush(1);

    if (!defined $komi) {
        if ($handicap > 0) {
	    $komi = 0.5;
	}
	else {
	    $komi = 5.5;
	}
    }

    print $prog_in  "boardsize $size\n";
    eat_no_response($prog_out);
    print $prog_in  "komi $komi\n";
    eat_no_response($prog_out);

    if (defined($stable)) {
        print $stable_in "komi $komi\n";
        eat_no_response($stable_out);
        print $stable_in "boardsize $size\n";
        eat_no_response($stable_out);
    }

    if (defined($randseed)) {
        print $prog_in "set_random_seed $randseed\n";
	eat_no_response($prog_out);
    } else {
        print $prog_in "get_random_seed\n";
	$randseed = eat_one_line($prog_out);
        $randseed =~ s/^= //smg;
	print "random seed $randseed\n";
    }

    if (defined($stable)) {
        print $stable_in "set_random_seed $randseed\n";
        eat_no_response($stable_out);
    }

    undef $randseed;   #if more than one game, get a new seed next time.

    print SGFFILEHANDLE "(;GM[1]FF[4]RU[Japanese]SZ[$size]HA[$handicap]KM[$komi]"
	if defined $sgffilename;

    my $pass = 0;
    $move = "";

    if ($handicap < 2) {
	$toplay = "black";
    }
    else {
	$toplay = "white";
	print $prog_in "fixed_handicap $handicap\n";

	$handicap_stones = eat_handicap($prog_out);
	my $stable_stones = $handicap_stones;

        if (defined($stable)) {
	    print $stable_in "fixed_handicap $handicap\n";
	    $stable_stones = eat_handicap($stable_out);
	}

	if ($stable_stones ne $handicap_stones) {
	    print "Handicap discrepancy:\n";
	    print "Test:   $handicap_stones\n";
	    print "Stable: $stable_stones\n";
	}

	if (defined $sgffilename) {
	    print SGFFILEHANDLE $handicap_stones;
	}
    }

    $movenum = 1;
    while ($pass < 2) {
	print $prog_in "genmove_$toplay\n";
	$move = eat_move($prog_out);

	if (defined($stable)) {
	    print $stable_in "genmove_$toplay\n" if defined($stable);
	    $stable_move = eat_move($stable_out);
	    print $stable_in "undo\n";
	    eat_no_response($stable_out);
	}

	if ($move ne $stable_move and defined ($stable)) {
	    print "At move $movenum, $toplay\:\n";
	    print "Test version played   $move\n";
	    print "Stable version played $stable_move\n";
	    if ($verbose eq 2) {
		print $prog_in "showboard\n";
		print eat_response($prog_out);
	    }
	} else {
	    print "$toplay plays $move\n" if $verbose;
	}

	$sgfmove = standard_to_sgf($move);
	my $tpc = "B"; #toplay char
	$tpc = "W" if ($toplay eq "white");
	print SGFFILEHANDLE ";$tpc\[$sgfmove\]\n" if defined $sgffilename;

	print $stable_in "$toplay $move\n" if defined($stable);
	eat_no_response($stable_out) if defined($stable);

	if ($toplay eq "black") {
	    $toplay = "white";
	} else {
	    $toplay = "black";
	}

	if ($move =~ /PASS/i) {
	    $pass++;
	} else {
	    $pass = 0;
	}

	if ($verbose > 2) {
	    print $prog_in "showboard\n";
	    eat_no_response($prog_out);
	    if (defined($stable)) {
	        print $stable_in "showboard\n";
		eat_no_response($stable_out);
	    }
	}

	check_matcher($prog_in, $prog_out) if !defined($noilcheck);
	$movenum++;
    }
    print $prog_in "estimate_score\n";
    $result = eat_score($prog_out);
    if (defined($stable)) {
        print $stable_in "estimate_score\n";
	my $stable_result = eat_score($stable_out);
	print "scoring discrepancy. Stable score: $stable_result.\n" if ($stable_result ne $result);
    }

    print "Result: $result\n";
    print $prog_in "quit\n";
    print $stable_in "quit\n" if defined($stable);

    if (defined $sgffilename) {
	print "sgf file: $sgffile\n";
	print SGFFILEHANDLE ")";
	close SGFFILEHANDLE;
	$game_list{$sgffile} = $result;
    }
    $games-- if $games > 0;

    #make sure gnugo dies correctly.
    close $prog_in;
    close $prog_out;
    close $stable_in if defined($stable);
    close $stable_out if defined($stable);
    waitpid $pidp, 0;
    waitpid $pids, 0;

    print "games remaining: $games\n";
}

if (defined $sgffilename) {
  my $index_out  = new FileHandle;
  open ($index_out, "> " . index_name($sgffilename));
  print $index_out
"<HTML><HEAD><TITLE>game results</TITLE></HEAD>
<BODY><H3>Game Results</H3>
<H4>White: ".html_encode($program)."</H4>
<H4>Black: ".html_encode($program)."</H4>
<TABLE border=1>
 <TR>
  <TD>SGF file</TD>
  <TD>Result</TD>
 </TR>
";
 foreach (sort by_result keys(%game_list)) {
    print $index_out "<TR><TD><A href=\"$_\">$_</A></TD>" .
    		"<TD>".html_encode(game_result($_))."</TD></TR>\n";
  }
  print $index_out "</TABLE></BODY></HTML>\n";
}

exit;
#all done here.

sub game_result {
  $_ = shift;
  $_ = $game_list{$_};
  #i.e.:  B+13.5 (upper bound: -13.5, lower: -13.5)|B+13.5 (upper bound: -13.5, lower: -13.5)
  #Make sure that all 4 values are the same.  I've not seen them different yet.
  #If they are ever different, need to improve the HTML output (now just -999) -
  # an explanation of the score mismatch problem would be appropriate.
  $_ =~ /^.*upper bound..([0-9+.\-]*)..lower..\1.\|.*upper bound..\1..lower..\1./;
  if (defined($1)) {
    return $1;
  } else {
    return -999;
  }
}

sub by_result {
  game_result($a) <=> game_result($b) || $a cmp $b;
}

sub html_encode {
  #print shift;
  my $r = shift;
  $r =~ s/&/&amp;/g;
  $r =~ s/</&lt;/g;
  $r =~ s/>/&gt;/g;
  return $r;
}

sub eat_no_response {
    my $h = shift;

# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
        $line =~ s/(\s|\n)*$//smg;
    }
}

sub eat_response {
    my $h = shift;
    my $response = "";
# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
        $line =~ s/(\s|\n)*$//smg;
    }
    while ($line ne "") {
	$response = "$response$line\n";
	chop($line = <$h>) or die "No response!";
        $line =~ s/(\s|\n)*$//smg;
    }
    return $response;
}

sub eat_one_line {
    my $h = shift;
# ignore empty lines
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
        $line =~ s/(\s|\n)*$//smg;
    }
    return $line;
}

sub eat_move {
    my $h = shift;
# ignore empty lines
    my $line = "";
    while ($line eq "") {
	if (!defined($line = <$h>)) {
	    print SGFFILEHANDLE ")";
	    close SGFFILEHANDLE;
	    die "Engine crashed!\n";
	}
        $line =~ s/(\s|\n)*$//smg;
    }
    my ($equals, $move) = split(' ', $line, 2);
    $line = <$h>;
    defined($move) or confess "no move found: line was: '$line'";
    return $move;
}

sub eat_handicap {
    my $h = shift;
    my $sgf_handicap = "AB";
# ignore empty lines, die if process is gone
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
    }
    @vertices = split(" ", $line);
    foreach $vertex (@vertices) {
	if (!($vertex eq "=")) {
	    $vertex = standard_to_sgf($vertex);
	    $sgf_handicap = "$sgf_handicap\[$vertex\]";
	}
    }
    return "$sgf_handicap;";
}

sub eat_score {
    my $h = shift;
# ignore empty lines, die if process is gone
    my $line = "";
    while ($line eq "") {
	chop($line = <$h>) or die "No response!";
	$line =~ s/^\s*//msg;
	$line =~ s/\s*$//msg;
    }
    $line =~ s/\s*$//;
    my ($equals, $result) = split(' ', $line, 2);
    $line = <$h>;
    return $result;
}

sub standard_to_sgf {
    for (@_) { confess "Yikes!" if !defined($_); }
    for (@_) { tr/A-Z/a-z/ };
    $_ = shift(@_);
    /([a-z])([0-9]+)/;
    return "tt" if $_ eq "pass";

    $first = ord $1;
    if ($first > 104) {
	$first = $first - 1;
    }
    $first = chr($first);
    $second = chr($size+1-$2+96);
    return "$first$second";
}

sub rename_sgffile {
    my $nogames = int shift(@_);
    $_ = shift(@_);
    s/\.sgf$//;
    # Annoying to loose _001 on game #1 in multi-game set.
    # Could record as an additional parameter.
    # return "$_.sgf" if ($nogames == 1);
    return sprintf("$_" . "_%03d.sgf", $nogames);
}

sub index_name {
    $_ = shift;
    s/\.sgf$//;
    return $_ . "_index.html";
}

sub check_matcher {
    #check for illegal transitions, and print things if they happen
    my $in = shift;
    my $out = shift;
    my $line = "";
    my $legality = "illegal";
    my $vertex = " ";
    my $new_status = " ";
    my $old_status;
    my $il_vertex = "";
    my $il_move = "";

    #send command
    print $in "dragon_status\n";

    while ($line eq "") {
        chop($line = <$out>);
	$line =~ s/^\s*//smg;
	$line =~ s/\s*$//smg;
    }

    while ($line ne "")
    {
        print "parsing a line\n" if ($verbose);
        $line =~ s/= //g;	#zap the "= " at the front of the response
	$line =~ s/\n//g;	#zap newlines...
	$line =~ s/://g;	#zap the :
	print $line . "\n" if ($verbose);
	($vertex, $new_status) = split(" ", $line);	#and split on spaces
							#extra get trashed
	$old_status = $match_hist{$vertex} if (exists($match_hist{$vertex}));

	#debug output
	if ($verbose > 1)
	{
	    print "Vertex: $vertex\n";
	    print "Old Status: $old_status\n" if (exists($match_hist{$vertex}));
	    print "New Status: $new_status\n";
	}

	#if it's new, we don't care
	if (!exists($match_hist{$vertex})) {
	    print "$vertex is new.\n" if ($verbose > 0);
	    $match_hist{$vertex} = $new_status;
	    next;
	}

	#ok, so it's old

	$legality = "illegal";
	if ($old_status eq "critical") {$legality = "legal"};
	if ($new_status eq "critical") {$legality = "legal"};
	if ($new_status eq "unknown") {$legality = "legal"};
	if ($old_status eq "unknown") {
	    if ($new_status eq "alive") {$legality = "legal";}
	    if ($new_status eq "critical") {$legality = "legal";}
	}
	if ($old_status eq "alive" and $new_status eq "dead") {
	    $legality = "killed";
	}

	if ($match_hist{$vertex} eq $new_status)
	{
	    #state didn't change -- valid result
	    print "$vertex remained unchanged.\n" if ($verbose > 0);
	} else
	{
	    #state changed
	    if ($legality eq "legal")
	    {
	        #legal state change
		if ($verbose > 1)
		{
		    print "Legal state change:\n";
		    print "Games remaining: $games\n";
		    print "Move: $movenum\n";
		    print "Vertex: $vertex\n";
		    print "Old Status: $old_status\n";
		    print "New Status: $new_status\n";
		    print "\n";
		}
	    } else
	    {
	        #illegal state change -- alive to dead or vice versa
		print "Illegal state change:\n";
		print "Games remaining: $games\n";
		print "Move: $movenum\n";
		print "Vertex: $vertex\n";
		print "Old Status: $old_status\n";
		print "New Status: $new_status\n";
		print "\n";

		#now print gtp output
		#FIXME: doesn't work with --loadsgf because we don't have
		#the move list available (it's hidden by using GTP loadsgf).
		#FIXME: currently, only produces GTP output for one transition
		#per move.  This is because we have to finish parsing the
		#entire output of dragon_status before dealing with finding
		#missed attacks.  Using arrays instead would fix it.
		if ($legality eq "killed" and !defined($loadfile)) {
        	    #The type we deal with now.
		    #FIXME: check for defensive errors too.
		    $il_move = $move;
		    $il_vertex = $vertex;
		}
	    }
	    $match_hist{$vertex} = $new_status;
	}
    } continue {
        chop($line = <$out>);
    }

    if ($il_move ne "") {
        print "attempting gtp output.\n";
        #undo the move, check owl_does_attack
        #and owl_attack, if they disagree,
        #output a regression test.
        print $in "undo\n";
        eat_no_response($out);
        my $oa_result = "";
        my $oda_result = "";
        print $in "owl_attack $il_vertex\n";
        $oa_result = eat_one_line($out);
        print "owl_attack $il_vertex\: $oa_result\n";
        print $in "owl_does_attack $il_move $il_vertex\n";
	$oda_result = eat_one_line($out);
	print "owl_does_attack $il_move $il_vertex\: $oda_result\n";

	#now try to do something with it
	if ($oa_result eq "= 0" and $oda_result ne "= 0") {
	    print "found a missed attack.\n\n";
	    print "loadsgf $sgffile $movenum\n";
	    print "owl_attack $il_vertex\n";
	    print "#$oa_result\n";
	    print "#? [1 $move]*\n\n";
	} else {
	    print "no missed attack found.\n\n";
	}

	#cancel the undo
	my $last_played = "black";
	if ($toplay eq "B") { $last_played = "white"; }
	print $in "genmove_$last_played\n";
	eat_move($out);
    }

    print "\n" if ($verbose > 0);
}