X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=39a0f4ba805f4312f6a12afe69be7757a6ed0384;hp=f383bb6e41088c38c4ba767d47cbb924eacab23c;hb=1856a6b8a4c1facbb3ff1df0f240acc9d378b315;hpb=8a95f87af48bd7388bf23115537f7e2381a2e17d diff --git a/remoteglot.pl b/remoteglot.pl index f383bb6..39a0f4b 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -209,7 +209,6 @@ sub handle_fics { for my $pos ($pos_waiting, $pos_calculating) { next if (!defined($pos)); if ($pos->fen() eq $pos_for_movelist->fen()) { - $pos->{'history'} = \@uci_movelist; $pos->{'pretty_history'} = \@pretty_movelist; } } @@ -269,37 +268,41 @@ sub handle_pgn { if (!defined($pgn) || !$pgn->read_game()) { warn "Error in parsing PGN from $url\n"; } else { - $pgn->quick_parse_game; - my $pos = Position->start_pos($pgn->white, $pgn->black); - my $moves = $pgn->moves; - my @uci_moves = (); - for my $move (@$moves) { - my $uci_move; - ($pos, $uci_move) = $pos->make_pretty_move($move); - push @uci_moves, $uci_move; - } - $pos->{'history'} = \@uci_moves; - $pos->{'pretty_history'} = $moves; - - # Sometimes, PGNs lose a move or two for a short while, - # or people push out new ones non-atomically. - # Thus, if we PGN doesn't change names but becomes - # shorter, we mistrust it for a few seconds. - my $trust_pgn = 1; - if (defined($last_pgn_white) && defined($last_pgn_black) && - $last_pgn_white eq $pgn->white && - $last_pgn_black eq $pgn->black && - scalar(@uci_moves) < scalar(@last_pgn_uci_moves)) { - if (++$pgn_hysteresis_counter < 3) { - $trust_pgn = 0; + eval { + $pgn->quick_parse_game; + my $pos = Position->start_pos($pgn->white, $pgn->black); + my $moves = $pgn->moves; + my @uci_moves = (); + for my $move (@$moves) { + my $uci_move; + ($pos, $uci_move) = $pos->make_pretty_move($move); + push @uci_moves, $uci_move; } - } - if ($trust_pgn) { - $last_pgn_white = $pgn->white; - $last_pgn_black = $pgn->black; - @last_pgn_uci_moves = @uci_moves; - $pgn_hysteresis_counter = 0; - handle_position($pos); + $pos->{'pretty_history'} = $moves; + + # Sometimes, PGNs lose a move or two for a short while, + # or people push out new ones non-atomically. + # Thus, if we PGN doesn't change names but becomes + # shorter, we mistrust it for a few seconds. + my $trust_pgn = 1; + if (defined($last_pgn_white) && defined($last_pgn_black) && + $last_pgn_white eq $pgn->white && + $last_pgn_black eq $pgn->black && + scalar(@uci_moves) < scalar(@last_pgn_uci_moves)) { + if (++$pgn_hysteresis_counter < 3) { + $trust_pgn = 0; + } + } + if ($trust_pgn) { + $last_pgn_white = $pgn->white; + $last_pgn_black = $pgn->black; + @last_pgn_uci_moves = @uci_moves; + $pgn_hysteresis_counter = 0; + handle_position($pos); + } + }; + if ($@) { + warn "Error in parsing moves from $url\n"; } } @@ -511,7 +514,7 @@ sub output { my $t = $tb_cache{$fen}; my $pv = $t->{'pv'}; - my $matelen = int((1 + scalar @$pv) / 2); + 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') { @@ -706,8 +709,7 @@ sub output_json { $json->{'seldepth'} = $info->{'seldepth'}; $json->{'tablebase'} = $info->{'tablebase'}; - # single-PV only for now - $json->{'pv_uci'} = $info->{'pv'}; + $json->{'pv_uci'} = $info->{'pv'}; # Still needs to be there for the JS to calculate arrows; only for the primary PV, though! $json->{'pv_pretty'} = [ prettyprint_pv($pos_calculating, @{$info->{'pv'}}) ]; my %refutation_lines = (); @@ -731,17 +733,66 @@ sub output_json { pretty_move => $pretty_move, pv_pretty => \@pretty_pv, }; - $refutation_lines{$pv->[0]}->{'pv_uci'} = $pv; }; } } $json->{'refutation_lines'} = \%refutation_lines; - open my $fh, ">", $remoteglotconf::json_output . ".tmp" + my $encoded = JSON::XS::encode_json($json); + atomic_set_contents($remoteglotconf::json_output, $encoded); + + if (exists($pos_calculating->{'pretty_history'}) && + defined($remoteglotconf::json_history_dir)) { + my $halfmove_num = scalar @{$pos_calculating->{'pretty_history'}}; + (my $fen = $pos_calculating->fen()) =~ tr,/ ,-_,; + my $filename = $remoteglotconf::json_history_dir . "/move$halfmove_num-$fen.json"; + + # Overwrite old analysis (assuming it exists at all) if we're + # using a different engine, or if we've calculated deeper. + # nodes is used as a tiebreaker. Don't bother about Multi-PV + # data; it's not that important. + my ($old_engine, $old_depth, $old_nodes) = get_json_analysis_stats($filename); + my $new_depth = $json->{'depth'} // 0; + my $new_nodes = $json->{'nodes'} // 0; + if (!defined($old_engine) || + $old_engine ne $json->{'id'}{'name'} || + $new_depth > $old_depth || + ($new_depth == $old_depth && $new_nodes >= $old_nodes)) { + atomic_set_contents($filename, $encoded); + } + } +} + +sub atomic_set_contents { + my ($filename, $contents) = @_; + + open my $fh, ">", $filename . ".tmp" or return; - print $fh JSON::XS::encode_json($json); + print $fh $contents; close $fh; - rename($remoteglotconf::json_output . ".tmp", $remoteglotconf::json_output); + rename($filename . ".tmp", $filename); +} + +sub get_json_analysis_stats { + my $filename = shift; + + my ($engine, $depth, $nodes); + + open my $fh, "<", $filename + or return undef; + local $/ = undef; + eval { + my $json = JSON::XS::decode_json(<$fh>); + $engine = $json->{'id'}{'name'} // die; + $depth = $json->{'depth'} // 0; + $nodes = $json->{'nodes'} // 0; + }; + close $fh; + if ($@) { + warn "Error in decoding $filename: $@"; + return undef; + } + return ($engine, $depth, $nodes); } sub uciprint { @@ -946,7 +997,8 @@ sub handle_tb_lookup_return { } $tb_cache{$fen} = { result => $pgn->result, - pv => \@uci_moves + pv => \@uci_moves, + score => $response->{'Response'}{'Score'}, }; output(); }