X-Git-Url: https://git.sesse.net/?p=remoteglot;a=blobdiff_plain;f=remoteglot.pl;h=d82c20bed25034896c341b979aa9a5b36bb0fac9;hp=b018e3841d8c336036f9fb8366d13fd1c5218a19;hb=88d92e1d44ad96601281d9ce96a525ac7df90757;hpb=d65c5b5001e2a61c2aa9e5fc97859515db69d72f diff --git a/remoteglot.pl b/remoteglot.pl index b018e38..d82c20b 100755 --- a/remoteglot.pl +++ b/remoteglot.pl @@ -31,6 +31,7 @@ no warnings qw(once); my $latest_update = undef; my $output_timer = undef; my $http_timer = undef; +my $stop_pgn_fetch = 0; my $tb_retry_timer = undef; my %tb_cache = (); my $tb_lookup_running = 0; @@ -231,6 +232,7 @@ sub handle_fics { fetch_pgn($url); } elsif ($msg =~ /^stoppgn$/) { $t->cmd("tell $who Stopping poll."); + $stop_pgn_fetch = 1; $http_timer = undef; } elsif ($msg =~ /^quit$/) { $t->cmd("tell $who Bye bye."); @@ -256,41 +258,53 @@ my $pgn_hysteresis_counter = 0; sub handle_pgn { my ($body, $header, $url) = @_; + + if ($stop_pgn_fetch) { + $stop_pgn_fetch = 0; + $http_timer = undef; + return; + } + my $pgn = Chess::PGN::Parse->new(undef, $body); 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->{'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; + } + } + 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"; } } @@ -502,7 +516,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') { @@ -937,7 +951,8 @@ sub handle_tb_lookup_return { } $tb_cache{$fen} = { result => $pgn->result, - pv => \@uci_moves + pv => \@uci_moves, + score => $response->{'Response'}{'Score'}, }; output(); }