+ $t->cmd("tell $who Couldn't understand '$msg', sorry.");
+ }
+ }
+ #print "FICS: [$line]\n";
+}
+
+# Starts periodic fetching of PGNs from the given URL.
+sub fetch_pgn {
+ my ($url) = @_;
+ AnyEvent::HTTP::http_get($url, sub {
+ handle_pgn(@_, $url);
+ });
+}
+
+my ($last_pgn_white, $last_pgn_black);
+my @last_pgn_uci_moves = ();
+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)) {
+ warn "Error in parsing PGN from $url [body='$body']\n";
+ } elsif (!$pgn->read_game()) {
+ warn "Error in reading PGN game from $url [body='$body']\n";
+ } elsif ($body !~ /^\[/) {
+ warn "Malformed PGN from $url [body='$body']\n";
+ } else {
+ eval {
+ # 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 $white = $pgn->white;
+ my $black = $pgn->black;
+ $white =~ s/,.*//; # Remove first name.
+ $black =~ s/,.*//; # Remove first name.
+ my $tags = $pgn->tags();
+ my $pos;
+ if (exists($tags->{'FEN'})) {
+ $pos = Position->from_fen($tags->{'FEN'});
+ $pos->{'player_w'} = $white;
+ $pos->{'player_b'} = $black;
+ $pos->{'start_fen'} = $tags->{'FEN'};
+ } else {
+ $pos = Position->start_pos($white, $black);
+ }
+ my $moves = $pgn->moves;
+ my @uci_moves = ();
+ my @repretty_moves = ();
+ for my $move (@$moves) {
+ my ($npos, $uci_move) = $pos->make_pretty_move($move);
+ push @uci_moves, $uci_move;
+
+ # Re-prettyprint the move.
+ my ($from_row, $from_col, $to_row, $to_col, $promo) = parse_uci_move($uci_move);
+ my ($pretty, undef) = $pos->{'board'}->prettyprint_move($from_row, $from_col, $to_row, $to_col, $promo);
+ push @repretty_moves, $pretty;
+ $pos = $npos;
+ }
+ if ($pgn->result eq '1-0' || $pgn->result eq '1/2-1/2' || $pgn->result eq '0-1') {
+ $pos->{'result'} = $pgn->result;
+ }
+ $pos->{'history'} = \@repretty_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
+ # 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);