my $http_timer = undef;
my $stop_pgn_fetch = 0;
my $tb_retry_timer = undef;
-my %tb_cache = ();
my $tb_lookup_running = 0;
my $last_written_json = undef;
return if ($engine->{'stopping'} && $line !~ /^bestmove/);
$engine->{'stopping'} = 0;
- if ($line =~ /^info/) {
+ if ($line =~ /^info/ && $line !~ / cluster /) {
my (@infos) = split / /, $line;
shift @infos;
$engine->{'info'} = {};
$last_move = time;
- schedule_tb_lookup();
-
#
# Output a command every move to note that we're
# still paying attention -- this is a good tradeoff,
# for new positions is off.
undef $pos_calculating_started;
- #
- # If we have tablebase data from a previous lookup, replace the
- # engine data with the data from the tablebase.
- #
- my $fen = $pos_calculating->fen();
- if (exists($tb_cache{$fen})) {
- for my $key (qw(pv score_cp score_mate nodes nps depth seldepth tbhits splicepos)) {
- delete $info->{$key . '1'};
- delete $info->{$key};
- }
- $info->{'nodes'} = 0;
- $info->{'nps'} = 0;
- $info->{'depth'} = 0;
- $info->{'seldepth'} = 0;
- $info->{'tbhits'} = 0;
-
- my $t = $tb_cache{$fen};
- my $pv = $t->{'pv'};
- my $matelen = int((1 + $t->{'score'}) / 2);
- if ($t->{'result'} eq '1/2-1/2') {
- $info->{'score_cp'} = 0;
- } elsif ($t->{'result'} eq '1-0') {
- if ($pos_calculating->{'toplay'} eq 'B') {
- $info->{'score_mate'} = -$matelen;
- } else {
- $info->{'score_mate'} = $matelen;
- }
- } else {
- if ($pos_calculating->{'toplay'} eq 'B') {
- $info->{'score_mate'} = $matelen;
- } else {
- $info->{'score_mate'} = -$matelen;
- }
- }
- $info->{'pv'} = $pv;
- $info->{'tablebase'} = 1;
- } else {
- $info->{'tablebase'} = 0;
- }
-
#
# Some programs _always_ report MultiPV, even with only one PV.
# In this case, we simply use that data as if MultiPV was never
$json->{'move_source_url'} = $remoteglotconf::move_source_url;
}
$json->{'score'} = score_digest($info, $pos_calculating, '');
- $json->{'using_lomonosov'} = defined($remoteglotconf::tb_serial_key);
$json->{'nodes'} = $info->{'nodes'};
$json->{'nps'} = $info->{'nps'};
$dbh->commit;
}
-sub schedule_tb_lookup {
- return if (!defined($remoteglotconf::tb_serial_key));
- my $pos = $pos_calculating;
- return if (exists($tb_cache{$pos->fen()}));
-
- # If there's more than seven pieces, there's not going to be an answer,
- # so don't bother.
- return if ($pos->num_pieces() > 7);
-
- # Max one at a time. If it's still relevant when it returns,
- # schedule_tb_lookup() will be called again.
- return if ($tb_lookup_running);
-
- $tb_lookup_running = 1;
- my $url = 'http://tb7-api.chessok.com:6904/tasks/addtask?auth.login=' .
- $remoteglotconf::tb_serial_key .
- '&auth.password=aquarium&type=0&fen=' .
- URI::Escape::uri_escape($pos->fen());
- print TBLOG "Downloading $url...\n";
- AnyEvent::HTTP::http_get($url, sub {
- handle_tb_lookup_return(@_, $pos, $pos->fen());
- });
-}
-
-sub handle_tb_lookup_return {
- my ($body, $header, $pos, $fen) = @_;
- print TBLOG "Response for [$fen]:\n";
- print TBLOG $header . "\n\n";
- print TBLOG $body . "\n\n";
- eval {
- my $response = JSON::XS::decode_json($body);
- if ($response->{'ErrorCode'} != 0) {
- die "Unknown tablebase server error: " . $response->{'ErrorDesc'};
- }
- my $state = $response->{'Response'}{'StateString'};
- if ($state eq 'COMPLETE') {
- my $pgn = Chess::PGN::Parse->new(undef, $response->{'Response'}{'Moves'});
- if (!defined($pgn) || !$pgn->read_game()) {
- warn "Error in parsing PGN\n";
- } else {
- $pgn->quick_parse_game;
- my $pvpos = $pos;
- my $moves = $pgn->moves;
- my @uci_moves = ();
- for my $move (@$moves) {
- my $uci_move;
- ($pvpos, $uci_move) = $pvpos->make_pretty_move($move);
- push @uci_moves, $uci_move;
- }
- $tb_cache{$fen} = {
- result => $pgn->result,
- pv => \@uci_moves,
- score => $response->{'Response'}{'Score'},
- };
- output();
- }
- } elsif ($state =~ /QUEUED/ || $state =~ /PROCESSING/) {
- # Try again in a second. Note that if we have changed
- # position in the meantime, we might query a completely
- # different position! But that's fine.
- } else {
- die "Unknown response state " . $state;
- }
-
- # Wait a second before we schedule another one.
- $tb_retry_timer = AnyEvent->timer(after => 1.0, cb => sub {
- $tb_lookup_running = 0;
- schedule_tb_lookup();
- });
- };
- if ($@) {
- warn "Error in tablebase lookup: $@";
-
- # Don't try this one again, but don't block new lookups either.
- $tb_lookup_running = 0;
- }
-}
-
sub open_engine {
my ($cmdline, $tag, $cb) = @_;
return undef if (!defined($cmdline));