+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->{'history'})) {
+ return;
+ }
+
+ my $id = id_for_pos($pos);
+ my $clock_info = $dbh->selectrow_hashref('SELECT * FROM clock_info WHERE id=? AND COALESCE(white_clock_target, black_clock_target) >= EXTRACT(EPOCH FROM (CURRENT_TIMESTAMP - INTERVAL \'1 day\'));', undef, $id);
+ if (defined($clock_info)) {
+ $pos->{'white_clock'} //= $clock_info->{'white_clock'};
+ $pos->{'black_clock'} //= $clock_info->{'black_clock'};
+ if ($pos->{'toplay'} eq 'W') {
+ $pos->{'white_clock_target'} = $clock_info->{'white_clock_target'};
+ } else {
+ $pos->{'black_clock_target'} = $clock_info->{'black_clock_target'};
+ }
+ 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};
+ my ($white_clock_target, $black_clock_target);
+ if ($pos->{'toplay'} eq 'W') {
+ $white_clock_target = $pos->{'white_clock_target'} = time + $time_left;
+ } else {
+ $black_clock_target = $pos->{'black_clock_target'} = time + $time_left;
+ }
+ local $dbh->{AutoCommit} = 0;
+ $dbh->do('DELETE FROM clock_info WHERE id=?', undef, $id);
+ $dbh->do('INSERT INTO clock_info (id, white_clock, black_clock, white_clock_target, black_clock_target) VALUES (?, ?, ?, ?, ?)', undef,
+ $id, $pos->{'white_clock'}, $pos->{'black_clock'}, $white_clock_target, $black_clock_target);
+ $dbh->commit;
+}
+