X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=7b3d9670771b14d6d3e4608ea237cd94b02c10c3;hp=39a0f4ba805f4312f6a12afe69be7757a6ed0384;hb=5cb23d6a532655d3d4ef0fdf30f8120bd93aa335;hpb=6bde401b27dd87a407f95b29fff99ed681ab8a4c diff --git a/remoteglot.pl b/remoteglot.pl index 39a0f4b..7b3d967 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -35,6 +35,10 @@ my $stop_pgn_fetch = 0; my $tb_retry_timer = undef; my %tb_cache = (); my $tb_lookup_running = 0; +my $last_written_json = undef; + +# TODO: Persist (parts of) this so that we can restart. +my %clock_target_for_pos = (); $| = 1; @@ -265,11 +269,17 @@ sub handle_pgn { } my $pgn = Chess::PGN::Parse->new(undef, $body); - if (!defined($pgn) || !$pgn->read_game()) { + if (!defined($pgn) || !$pgn->read_game() || $body !~ /^\[/) { warn "Error in parsing PGN from $url\n"; } else { eval { - $pgn->quick_parse_game; + # Skip to the right game. + while (defined($remoteglotconf::pgn_filter) && + !&$remoteglotconf::pgn_filter($pgn)) { + $pgn->read_game() or die "Out of games during filtering"; + } + + $pgn->parse_game({ save_comments => 'yes' }); my $pos = Position->start_pos($pgn->white, $pgn->black); my $moves = $pgn->moves; my @uci_moves = (); @@ -278,8 +288,11 @@ sub handle_pgn { ($pos, $uci_move) = $pos->make_pretty_move($move); push @uci_moves, $uci_move; } + $pos->{'result'} = $pgn->result; $pos->{'pretty_history'} = $moves; + extract_clock($pgn, $pos); + # 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 @@ -302,7 +315,7 @@ sub handle_pgn { } }; if ($@) { - warn "Error in parsing moves from $url\n"; + warn "Error in parsing moves from $url: $@\n"; } } @@ -313,18 +326,38 @@ sub handle_pgn { sub handle_position { my ($pos) = @_; + find_clock_start($pos, $pos_calculating); - # if this is already in the queue, ignore it - return if (defined($pos_waiting) && $pos->fen() eq $pos_waiting->fen()); + # if this is already in the queue, ignore it (just update the result) + if (defined($pos_waiting) && $pos->fen() eq $pos_waiting->fen()) { + $pos_waiting->{'result'} = $pos->{'result'}; + return; + } # if we're already chewing on this and there's nothing else in the queue, # also ignore it - return if (!defined($pos_waiting) && defined($pos_calculating) && - $pos->fen() eq $pos_calculating->fen()); + if (!defined($pos_waiting) && defined($pos_calculating) && + $pos->fen() eq $pos_calculating->fen()) { + $pos_calculating->{'result'} = $pos->{'result'}; + return; + } # if we're already thinking on something, stop and wait for the engine # to approve if (defined($pos_calculating)) { + # Store the final data we have for this position in the history, + # with the precise clock information we just got from the new + # position. (Historic positions store the clock at the end of + # the position.) + # + # Do not output anything new to the main analysis; that's + # going to be obsolete really soon. + $pos_calculating->{'white_clock'} = $pos->{'white_clock'}; + $pos_calculating->{'black_clock'} = $pos->{'black_clock'}; + delete $pos_calculating->{'white_clock_target'}; + delete $pos_calculating->{'black_clock_target'}; + output_json(1); + if (!defined($pos_waiting)) { uciprint($engine, "stop"); } @@ -572,7 +605,7 @@ sub output { } output_screen(); - output_json(); + output_json(0); $latest_update = [Time::HiRes::gettimeofday]; } @@ -694,6 +727,7 @@ sub output_screen { } sub output_json { + my $historic_json_only = shift; my $info = $engine->{'info'}; my $json = {}; @@ -739,13 +773,15 @@ sub output_json { $json->{'refutation_lines'} = \%refutation_lines; my $encoded = JSON::XS::encode_json($json); - atomic_set_contents($remoteglotconf::json_output, $encoded); + unless ($historic_json_only || !defined($remoteglotconf::json_output) || + (defined($last_written_json) && $last_written_json eq $encoded)) { + atomic_set_contents($remoteglotconf::json_output, $encoded); + $last_written_json = $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"; + my $filename = $remoteglotconf::json_history_dir . "/" . id_for_pos($pos_calculating) . ".json"; # Overwrite old analysis (assuming it exists at all) if we're # using a different engine, or if we've calculated deeper. @@ -773,6 +809,14 @@ sub atomic_set_contents { rename($filename . ".tmp", $filename); } +sub id_for_pos { + my $pos = shift; + + my $halfmove_num = scalar @{$pos->{'pretty_history'}}; + (my $fen = $pos->fen()) =~ tr,/ ,-_,; + return "move$halfmove_num-$fen"; +} + sub get_json_analysis_stats { my $filename = shift; @@ -946,6 +990,118 @@ sub book_info { return $text; } +sub extract_clock { + my ($pgn, $pos) = @_; + + # Look for extended PGN clock tags. + my $tags = $pgn->tags; + if (exists($tags->{'WhiteClock'}) && exists($tags->{'BlackClock'})) { + $pos->{'white_clock'} = hms_to_sec($tags->{'WhiteClock'}); + $pos->{'black_clock'} = hms_to_sec($tags->{'BlackClock'}); + return; + } + + # Look for TCEC-style time comments. + my $moves = $pgn->moves; + my $comments = $pgn->comments; + my $last_black_move = int((scalar @$moves) / 2); + my $last_white_move = int((1 + scalar @$moves) / 2); + + my $black_key = $last_black_move . "b"; + my $white_key = $last_white_move . "w"; + + if (exists($comments->{$white_key}) && + exists($comments->{$black_key}) && + $comments->{$white_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/ && + $comments->{$black_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/) { + $comments->{$white_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/; + $pos->{'white_clock'} = hms_to_sec($1); + $comments->{$black_key} =~ /(?:tl=|clk )(\d+:\d+:\d+)/; + $pos->{'black_clock'} = hms_to_sec($1); + return; + } + + delete $pos->{'white_clock'}; + delete $pos->{'black_clock'}; +} + +sub hms_to_sec { + my $hms = shift; + return undef if (!defined($hms)); + $hms =~ /(\d+):(\d+):(\d+)/; + return $1 * 3600 + $2 * 60 + $3; +} + +sub find_clock_start { + my ($pos, $prev_pos) = @_; + + # If the game is over, the clock is stopped. + if (exists($pos->{'result'}) && + ($pos->{'result'} eq '1-0' || + $pos->{'result'} eq '1/2-1/2' || + $pos->{'result'} eq '0-1')) { + return; + } + + # When we don't have any moves, we assume the clock hasn't started yet. + if ($pos->{'move_num'} == 1 && $pos->{'toplay'} eq 'W') { + if (defined($remoteglotconf::adjust_clocks_before_move)) { + &$remoteglotconf::adjust_clocks_before_move(\$pos->{'white_clock'}, \$pos->{'black_clock'}, 1, 'W'); + } + return; + } + + # TODO(sesse): Maybe we can get the number of moves somehow else for FICS games. + # The history is needed for id_for_pos. + if (!exists($pos->{'pretty_history'})) { + return; + } + + my $id = id_for_pos($pos); + if (exists($clock_target_for_pos{$id})) { + if ($pos->{'toplay'} eq 'W') { + $pos->{'white_clock_target'} = $clock_target_for_pos{$id}; + } else { + $pos->{'black_clock_target'} = $clock_target_for_pos{$id}; + } + return; + } + + # OK, we haven't seen this position before, so we assume the move + # happened right now. + + # See if we should do our own clock management (ie., clock information + # is spurious or non-existent). + if (defined($remoteglotconf::adjust_clocks_before_move)) { + my $wc = $pos->{'white_clock'} // $prev_pos->{'white_clock'}; + my $bc = $pos->{'black_clock'} // $prev_pos->{'black_clock'}; + if (defined($prev_pos->{'white_clock_target'})) { + $wc = $prev_pos->{'white_clock_target'} - time; + } + if (defined($prev_pos->{'black_clock_target'})) { + $bc = $prev_pos->{'black_clock_target'} - time; + } + &$remoteglotconf::adjust_clocks_before_move(\$wc, \$bc, $pos->{'move_num'}, $pos->{'toplay'}); + $pos->{'white_clock'} = $wc; + $pos->{'black_clock'} = $bc; + } + + my $key = ($pos->{'toplay'} eq 'W') ? 'white_clock' : 'black_clock'; + if (!exists($pos->{$key})) { + # No clock information. + return; + } + my $time_left = $pos->{$key}; + $clock_target_for_pos{$id} = time + $time_left; + if ($pos->{'toplay'} eq 'W') { + $pos->{'white_clock_target'} = $clock_target_for_pos{$id}; + delete $pos->{'black_clock_target'}; + } else { + $pos->{'black_clock_target'} = $clock_target_for_pos{$id}; + delete $pos->{'white_clock_target'}; + } +} + sub schedule_tb_lookup { return if (!defined($remoteglotconf::tb_serial_key)); my $pos = $pos_waiting // $pos_calculating;