tourney-manager 20070820-4 / usr / share / tourney-manager / Tourney.pm

#!/usr/bin/perl
# $Id: Tourney.pm 430 2007-08-19 19:47:12Z holger $
#
# Copyright (C) 2005-2007 Holger Ruckdeschel <holger@hoicher.de>
#
# This program is free software; you can redistribute it and/or
# modify it under the terms of the GNU General Public License
# as published by the Free Software Foundation; either version 2
# of the License, or (at your option) any later version.
# 
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
# 
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston,
# MA 02110-1301, USA.
#

package Tourney;
use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(verbose debug print_version
		tourney_name runner_running
		is_locked
		clear_tourney print_tourney create_tourney update_tourney
		replay_game
		start_tourney stop_tourney
		);

use warnings;
use strict;

use Fcntl;
use File::Basename;
use File::Copy;
use File::Glob ':glob';
use IPC::Open3;
use List::Util qw(shuffle);
use threads;
use threads::shared;
use YAML qw(DumpFile LoadFile);


our $verbose = 0;
our $debug = 0;


my @svn_rev_tmp = split(/\s+/, '$Rev: 430 $');
my $MODULE_VERSION = '0.' . $svn_rev_tmp[1];


our $tourney_name = "example";
my $configfile;
my $statefile;
my $lockfile;

my $STATE_VERSION = 7;
my $state;


my $runner_thread;
our $runner_running : shared = 0;
my @worker_threads;
my @worker_running : shared;
my $nr_worker_threads = 1;


my $intr_now : shared;
my $intr_turn : shared;
my $skip_match : shared;


init();


###############################################################################
# General functions
###############################################################################

sub print_version {
	print( <<EOF
xboard tourney manager version $MODULE_VERSION
Copyright (C) 2005-2007 Holger Ruckdeschel <holger\@hoicher.de>
This program is free software and comes with ABSOLUTELY NO WARRANTY.
See the GNU General Public License for more details.
EOF
	);
}

sub init {
}

###############################################################################
# Functions to access saved state
###############################################################################

sub init_state {
	$configfile = "$tourney_name.conf";
	$statefile  = "$tourney_name.state";
	$lockfile   = "$tourney_name.lock";
	
	undef $state;
	$state = {
		_version => $STATE_VERSION,
		# status => 'uninitialized',
		# type => 'uninitialized',
		settings => {},
		engines => {},
		players => [],
		gauntlet_players => [],
		matches => [],
	};
	
	if (-s $statefile && load_state()) {
		return 1;
	} else {
		return 0;
	}
}

sub save_state {
	if (! -s $lockfile) {
		die("save_state(): tourney is not locked.\n");
	}
	
	# Check if we have really locked the state before overwriting it.
	open(FH, $lockfile)
			or die("save_state(): cannot open $lockfile: $!\n");
	my $pid = <FH>;
	close(FH);
	if ($pid != $$) {
		die("save_state(): pid in lockfile ($pid) does not match"
				. " our pid ($$).\n");
	}
	
	DumpFile($statefile, $state);
	return 1;
}

sub load_state {
	my $s = LoadFile($statefile);
	
	my $v = $s->{_version};
	if (!defined($v)) {
		$v = 0;
	}
	if ($v != $STATE_VERSION) {
		print("Error: State version mismatch: state file $statefile"
			. " is version $v,"
			. " but version $STATE_VERSION is required.\n");
		return 0;
	}

	$state = $s;

	print("Loaded tourney state from $statefile (state version $v).\n")
			if ($debug);
	return 1;
}

sub lock_tourney {
	sysopen(LOCKFILE, $lockfile, O_WRONLY | O_EXCL | O_CREAT)
		or die("Cannot create lock file $lockfile: $!\n");
	print(LOCKFILE $$);
	close(LOCKFILE);
}

sub try_lock_tourney {
	if (-e $lockfile) {
		print("Tourney is locked ($lockfile exists).\n");
		return 0;
	} else {
		lock_tourney();
		return 1;
	}
}

sub unlock_tourney {
	unlink($lockfile) or die("Cannot unlink lock file $lockfile: $!\n");
}

sub backup_state {
	if (! -s $lockfile) {
		die("save_state(): tourney is not locked.\n");
	}
	
	my $i = 0;
	my $statefile_bak;
	do {
		$statefile_bak = "$statefile.$i";
		$i++;
	} while (-e $statefile_bak);

	copy($statefile, $statefile_bak)
		or die("Cannot copy $statefile to $statefile_bak: $!\n");
	print("Tourney state backed up to $statefile_bak.\n");
}

###############################################################################
# Functions to initialize tourney
###############################################################################

sub set_defaults {
	# These are default values.
	$state->{settings}->{xboard_path} = "xboard";
	$state->{settings}->{xboard_user_args} = "";
	$state->{settings}->{winboard} = 0;
	$state->{settings}->{games_per_match} = 1;
	$state->{settings}->{games_per_turn} = 0;
	$state->{settings}->{time_per_session} = 5;
	$state->{settings}->{time_increment} = -1;
	$state->{settings}->{moves_per_session} = 40;
	
	$state->{type} = 'rr';
}

sub read_config {
	my ($configfile) = @_;
	
	my $engine_name;

	my $fh;
	if (! open($fh, $configfile)) {
		print("Error: Cannot open $configfile: $!\n");
		return 0;
	}
	
	while (<$fh>) {
		chomp;
		s/#.*$//;
		s/^\s*//;
		s/\s*$//;
		if (/^$/) {
			next;
		}
	
		if (/^\s*include\s+(.*)\s*$/) {
			my $includefile = $1;
			print("$configfile:$.: include: $includefile\n")
					if ($debug);
			my $ret = read_config($includefile);
			if (!$ret) {
				return $ret;
			}
			next;
		}

		
		if (! /^\s*([^=\s]+)\s*=\s*(.*)\s*$/) {
			print("$configfile:$.: Error: ");
			print("Illegal line in config file: $_\n");
			return 0;
		}
		my $param = $1;
		my $value = $2;
		print("$configfile:$.: param='$param', value='$value'\n")
				if ($debug);

		
		if ($param eq "xboard_path" 
				|| $param eq "xboard_user_args"
				|| $param eq "winboard") {
			$state->{settings}->{$param} = $value;
		
		} elsif ($param eq "games_per_match"
				|| $param eq "games_per_turn"
				|| $param eq "time_per_session"
				|| $param eq "time_increment"
				|| $param eq "moves_per_session") {
			if ($value !~ /^\d+$/) {
				print("$configfile:$.: Error: ");
				print("Value of parameter '$param' must"
					. " be a number, not '$value'\n");
				return 0;
			}
			$state->{settings}->{$param} = $value;

		} elsif ($param eq "type") {
			$state->{type} = $value;
			
		} elsif ($param eq "player") {
			push(@{$state->{players}}, $value);		
		
		} elsif ($param eq "gauntlet_player"
				|| $param eq "gauntlet_engine") {
			push(@{$state->{gauntlet_players}}, $value);		
		
		} elsif ($param eq "engine") {
			$engine_name = $value;

			# Make sure values are defined even if they're not
			# in the configuation file. However, don't overwrite
			# any existing values.
			if (!defined($state->{engines}->{$engine_name})) { 
				$state->{engines}->{$engine_name} = {
					name => $engine_name,
					bin => "/bin/false",
					dir => ".",
					args => "",
				};
			}
		
		} elsif ($param eq "name"
				|| $param eq "bin"
				|| $param eq "dir"
				|| $param eq "args") {
			$state->{engines}->{$engine_name}->{$param} = $value;
			
		} else {
			print("$configfile:$.: Error: ");
			print("Unknown parameter: $param\n");
			return 0;
		}
	}
	
	close($fh);
	return 1;
}

sub is_locked {
	init_state() || return;
	
	if (-e $lockfile) {
		return 1;
	} else {
		return 0;
	}
}

sub clear_tourney {
	my ($args) = @_;		
	
	init_state() || return 0;
	try_lock_tourney() || return 0;
	
	if (-e $statefile) {
		unlink($statefile)
				or die("Error: cannot unlink $statefile: $!\n");
		for (my $i = 0; ; $i++) {
			my $f = "$statefile.$i";
			if (! -e $f) {
				last;
			}
			unlink($f) or die("Error: cannot unlink $f: $!\n");
		}
	}
	undef $state;
	print("State of tourney `$tourney_name' removed.\n");

	
	if ($args->{delete_logs}) {
		foreach my $f (bsd_glob("$tourney_name.match-*.log*")) {
			unlink($f) or die("Error: cannot unlink $f: $!\n");
		}
		print("Logfiles of tourney `$tourney_name' removed.\n");
	}
	
	if ($args->{delete_pgns}) {
		foreach my $f (bsd_glob("$tourney_name.match-*.pgn*")) {
			unlink($f) or die("Error: cannot unlink $f: $!\n");
		}
		print("PGN files of tourney `$tourney_name' removed.\n");
	}
	
	unlock_tourney();
	return 1;
}

sub create_tourney {
	if (init_state()) {
		print("Tourney `$tourney_name' already created.\n");
		return 0;
	}
	try_lock_tourney() || return 0;
	set_defaults();
	if (!read_config($configfile)) {
		unlock_tourney();
		return 0;
	}

	#
	# Create player list
	#
	generate_playerlist();
	check_playerlist() || return 0;
	
	#
	# Generate matches
	# 
	if ($state->{type} eq 'rr') {
		# normal round robin tourney
		@{$state->{matches}}
			= rutschsystem(shuffle(@{$state->{players}}));
	} elsif ($state->{type} eq 'gauntlet') {
		# first create normal round robin tourney, then remove
		# all matches where none of the gauntlet players take
		# part.
		my @tmp_matches
			= rutschsystem(shuffle(@{$state->{players}}));

		foreach my $m (@tmp_matches) {
			my $ok = 0;
			foreach my $p (@{$state->{gauntlet_players}}) {
				if ($p eq $m->{white} || $p eq $m->{black}) {
					$ok = 1;
					last;
				}
			}

			if ($ok) {
				push(@{$state->{matches}}, $m);
			}
		}
	} else {
		print("Illegal tourney type: $state->{type}\n");
		return 0;
	}

	#
	# Set result string
	#
	my $gpm = $state->{settings}->{games_per_match};
	foreach my $match (@{$state->{matches}}) {
		if (!defined($match->{result})) {
			$match->{result} = "." x $gpm;
		} elsif (length($match->{result}) < $gpm) {
			$match->{result} .= "."
				x ($gpm - length($match->{result}));
		}
	}
	
	#
	# Misc
	# 
	if ($state->{settings}->{games_per_turn} <= 0) {
		$state->{settings}->{games_per_turn}
			= $state->{settings}->{games_per_match};
	}

	$state->{status} = "ready";

	#
	# Done.
	#
	save_state();
	unlock_tourney();
	print("Tourney `$tourney_name' created.\n");
	return 1;
}

sub update_tourney {
	if (!init_state()) {
		print("Tourney `$tourney_name' not yet created.\n");
		return 0;
	}
	try_lock_tourney() || return 0;

	
	# Save old player list and clear it.
	my @oldplayers = @{$state->{players}};
	$state->{players} = [];

	if (!read_config($configfile)) {
		unlock_tourney();
		return 0;
	}

	#
	# Update player list
	#	
	generate_playerlist();
	check_playerlist() || return 0;

	#	
	# Determine list of new players
	#
	my @allplayers = @{$state->{players}};
	my @newplayers;
	foreach my $p (@allplayers) {
		if (! grep { $p eq $_ } @oldplayers) {
			push(@newplayers, $p);
			print("New player: $p\n");
		}
	}

	#
	# Generate matches for new players
	# 
	# FIXME This will not work correctly if an already existing player
	#       was only added as new gauntlet player.
	#
	if ($state->{type} eq 'rr' || $state->{type} eq 'gauntlet') {
		my @gauntlet_players = @{$state->{gauntlet_players}};
		my $playswhite = 1;
		my $lastmatch = $state->{matches}->[$#{$state->{matches}}];
		my $round = $lastmatch->{round} + 1;
		my $matchnr1 = $lastmatch->{number} + 1;
		
		foreach my $np (@newplayers) {
			foreach my $p (@oldplayers) {
				if ($p eq $np) {
					next;
				} elsif ($state->{type} eq 'gauntlet'
						&& !grep { 
							$_ eq $p || $_ eq $np }
							@gauntlet_players) {
					next;
				}
				
				my $white;
				my $black;
				if ($playswhite) {
					$white = $np;
					$black = $p;
				} else {
					$white = $p;
					$black = $np;
				}
				
				printf("New match: %d. %s -- %s (round %d)\n",
						$matchnr1,
						$white,
						$black,
						$round);

				push(@{$state->{matches}}, {
					round => $round, number => $matchnr1,
					white => $white, black => $black });
				
				$matchnr1++;
				$playswhite = !$playswhite;
			}

			# Put new player into list of existing players, so
			# that it will play agains other new players.
			push(@oldplayers, $np);
			
			$round++;
		}
	} else {
		print("Illegal tourney type: $state->{type}\n");
		return 0;
	}
	
	#
	# Set result string
	#
	my $gpm = $state->{settings}->{games_per_match};
	foreach my $match (@{$state->{matches}}) {
		if (!defined($match->{result})) {
			$match->{result} = "." x $gpm;
		} elsif (length($match->{result}) < $gpm) {
			$match->{result} .= "."
				x ($gpm - length($match->{result}));
		}
	}

	#
	# Done.
	#
	backup_state();
	$state->{status} = "updated";
	save_state();
	unlock_tourney();
	print("Tourney `$tourney_name' updated.\n");
	return 1;
}

sub rutschsystem {
	my @players = @_;
	
	my $nplayers = @players;
	
	my $even = @players%2 == 0;
	my $nr_rounds = $even ? $nplayers-1 : $nplayers;
	
	my @players2 = @players;
	my @players1 = splice(@players2, 0, $nplayers/2);
	#print("players1 = @players1\n");
	#print("players2 = @players2\n");

	my @matches;
	my $m = 0;
	for (my $round=1; $round<=$nr_rounds; $round++) {
		#printf("Round %d:\n", $round);
		my $nr_boards = ($nplayers-1) / 2;
		for (my $i=0; $i<$nr_boards; $i++) {
			my $white;
			my $black;

			# With an even number of players, the first board
			# ($i == 0) must be flipped each round. All other
			# boards remain fixed (as will the first board when
			# the number of players is odd), with alternating
			# positions of white and black.
			if ($even && $i == 0) {
				if ($round%2 == 1) {
					$white = $players1[$i];
					$black = $players2[$i];
				} else {
					$white = $players2[$i];
					$black = $players1[$i];
				}
			} elsif ($i%2 == 0) {
				$white = $players1[$i];
				$black = $players2[$i];
			} else {
				$white = $players2[$i];
				$black = $players1[$i];
			}

			$m++;
			#print("$m. $white -- $black\n");
			push(@matches, { round => $round, number => $m,
					white => $white, black => $black });
		}

		# With an even number of players, the first player will
		# always remain at his position.
		if ($even) {
			my $tmp = shift(@players1);
			push(@players2, pop(@players1));
			unshift(@players1, shift(@players2));
			unshift(@players1, $tmp);
		} else {
			push(@players2, pop(@players1));
			unshift(@players1, shift(@players2));
		}
		#print("players1 = @players1\n");
		#print("players2 = @players2\n");
	}

	return @matches;
}

###############################################################################
# Print functions
###############################################################################

sub print_tourney {
	init_state() || return;
	
	print("Tourney status: $state->{status}\n");
	print("\n");
	print("Tourney type: $state->{type}\n");
	print("\n");
	
	print("Tourney settings:\n");
	printf("\tGames per match: %d\n",
			$state->{settings}->{games_per_match});
	printf("\tTime per session: %d min\n",
			$state->{settings}->{time_per_session});
	printf("\tTime increment: %d sec\n",
			$state->{settings}->{time_increment})
		if ($state->{settings}->{time_increment} != -1);
	printf("\tMoves per session: %d\n",
			$state->{settings}->{moves_per_session}) 
		if ($state->{settings}->{time_increment} == -1);

	
	print("\n");
	
	my $maxlen = get_length_of_longest_engine_name();
	my @participants;
	foreach my $e (@{$state->{players}}) {
		my $tmp = sprintf("%-${maxlen}s",
				$state->{engines}->{$e}->{name});
		if ($state->{type} eq 'gauntlet' 
				&& grep { $_ eq $e; }
					@{$state->{gauntlet_players}}) {
			$tmp .= "  [gauntlet player]";
		}
		push(@participants, $tmp);
	}
	my $nparticipants= @participants;
	print("Participants: $nparticipants\n");
	foreach my $p (sort(@participants)) {
		print("\t$p\n");
	}
	
	print("\n");
	
	my $nr_matches = @{$state->{matches}};
	print("Number of matches: $nr_matches\n");
	
	print("\n");
	
	my $round = 0;
	foreach my $match (@{$state->{matches}}) {
		if ($match->{round} != $round) {
			$round = $match->{round};
			print("Round $round:\n");
		}
		
		print_match($match);
	}
}

sub print_match {
	my ($match) = @_;
	
	my $maxlen = get_length_of_longest_engine_name(); 
	
	my $result = $match->{result};
	my $whitepts = 0;
	my $blackpts = 0;
	for (my $i = 0; $i < length($result); $i++) {
		my $r = substr($result, $i, 1);
		if ($r eq '1') {
			$whitepts += 1;
		} elsif ($r eq '0') {
			$blackpts += 1;
		} elsif ($r eq '=') {
			$whitepts += 0.5;
			$blackpts += 0.5;
		}		
	}
	
	printf("%4d. %-${maxlen}s  --  %-${maxlen}s\t%s  (%.1f-%.1f)\n",
			$match->{number},
			$state->{engines}->{$match->{white}}->{name},
			$state->{engines}->{$match->{black}}->{name},
			$result,
			$whitepts, $blackpts);
}


###############################################################################
# Runner thread handling functions
###############################################################################

sub start_tourney {
	($nr_worker_threads) = @_;

	if ($runner_running) {
		print("Runner thread already running.\n");
		return 0;
	}

	$intr_now = 0;
	$intr_turn = 0;
	$skip_match = 0;

	$runner_running = 1;
	$runner_thread = threads->new(\&runner);
	$runner_thread->detach();
	return 1;
}

sub stop_tourney {
	if (!$runner_running) {
		print("Runner thread not running.\n");
		return;
	}

	if (defined($_[0]) && $_[0] eq "turn") {
		$intr_turn = 1;
		print("Tourney will be interrupted at end of current turn.\n");
	} elsif (defined($_[0]) && $_[0] eq "match") {
		$skip_match = 1;
		print("Current match will be skipped after current game has finished.\n");
	} else {
		$intr_now = 1;
		print("Tourney will be interrupted after current game.\n");
	}
}

sub runner {
	print("Runner thread started.\n");
	run_tourney();
	print("Runner thread terminated.\n");
	$runner_running = 0;
}

###############################################################################
# Functions to modify tourney
###############################################################################

sub replay_game {
	init_state() || return;
	try_lock_tourney() || return;
	
	# If 2nd argument is undefined, all games of a match will be replayed.
	my ($matchnr1, $gamenr1) = @_;

	# Ugh. We cannot just use '$state->{matches}->[$matchnr1-1]',
	# because for gauntlet tourneys, the match array isn't dense.
	my $match;
	foreach my $m (@{$state->{matches}}) {
		if ($m->{number} == $matchnr1) {
			$match = $m;
			last;
		}
	}
	if (! defined($match)) {
		print("Error: Illegal match number: $matchnr1\n");
		unlock_tourney();
		return;
	}

	# shortcuts
	my $gpm = $state->{settings}->{games_per_match};
	
	if (! defined($gamenr1)) {
		# replay all games
		for (my $gamenr = 0; $gamenr < $gpm; $gamenr++) {
			printf("Game %d/%d will be replayed.\n",
					$matchnr1, $gamenr+1);
			substr($match->{result}, $gamenr, 1) = '.';
			moveaway_logpgn($matchnr1, $gamenr+1);
		}
	} else {
		if ($gamenr1-1 < 0 || $gamenr1-1 >= $gpm) {
			print("Error: Illegal game number: $gamenr1\n");
			unlock_tourney();
			return;
		}
		
		# replay single game
		printf("Game %d/%d will be replayed.\n", $matchnr1, $gamenr1);
		substr($match->{result}, $gamenr1-1, 1) = '.';
		moveaway_logpgn($matchnr1, $gamenr1);
	}
	
	save_state();
	unlock_tourney();
}

###############################################################################
# Functions to run tourney
###############################################################################

sub run_tourney {
	init_state() || return;
	try_lock_tourney() || return;
	$state->{status} = "running";
	save_state();

	# shortcuts
	my $gpm = $state->{settings}->{games_per_match};
	my $gpt = $state->{settings}->{games_per_turn};
	
	# First clear any bad result codes of unfinished games.
	foreach my $match (@{$state->{matches}}) {
		my $matchnr1 = $match->{number};
		for (my $gamenr = 0; $gamenr < $gpm; $gamenr++) {
			my $r = substr($match->{result}, $gamenr, 1);
			if ($r =~ /[\*ER]/) {
				printf("Game %d/%d was not finished correctly"
						. " last time (result '$r'),"
						. " replaying.\n",
						$matchnr1, $gamenr+1);
				substr($match->{result}, $gamenr, 1) = '.';
				moveaway_logpgn($matchnr1, $gamenr+1);
			}
		}
	}
	
	save_state();

	# Initialize worker threads.
	undef @worker_threads;
	undef @worker_running;
	for (my $ti = 0; $ti < $nr_worker_threads; $ti++) {
		push(@worker_threads, undef);
		push(@worker_running, 0);
	}
	
	# Run games ...
	my $nr_turns = $gpm / $gpt + 1;
	for (my $turn = 0; $turn < $nr_turns; $turn++) {
		foreach my $match (@{$state->{matches}}) {
			if ($intr_now) {
				last;
			}
			
			my $matchnr1 = $match->{number};
			for (my $gamenr = $turn*$gpt; $gamenr < ($turn+1) * $gpt
						&& $gamenr < $gpm; $gamenr++) {
				my $r = substr($match->{result}, $gamenr, 1);
				if ($r =~ /[10=]/) {
					next;			
				} elsif ($r =~ /[\*ER]/) {
					printf("Error: game %d/%d has bad result code '$r'.\n",
							$matchnr1, $gamenr+1);
					$intr_now = 1;
					return;			
				} elsif ($r =~ /[\.]/) {
					# find idle thread
					my $found = 0;
					while (!$found) {
						join_workers(0);
						if ($intr_now) {
							last;
						}

						for (my $ti = 0; $ti < $nr_worker_threads; $ti++) {
							if (defined($worker_threads[$ti])) {
								next;
							}

							substr($match->{result}, $gamenr, 1) = 'R';
							save_state();

							# Start thread. 
							# Ugh. Since &worker returns a list,
							# we need to create the thread object in list
							$worker_running[$ti] = 1;
							($worker_threads[$ti]) = threads->new(\&worker,
									$ti, $match, $gamenr);
							$found = 1;
							last;
						}
						if ($found) {
							last;
						}
						sleep 1;
					}

					join_workers(0);
				} else {
					printf("Error: game %d/%d has illegal result code"
								. " '$r'.\n",
							$matchnr1, $gamenr+1);
					$intr_now = 1;
					return;
				}
				
				join_workers(0);

				if ($intr_now || $skip_match) {
					last;
				}
			}
		}

		join_workers(0);

		if ($intr_turn) {
			last;
		}


	}

	join_workers(1);

	# Count failed matches.
	my $failed_matches = 0;
	foreach my $match (@{$state->{matches}}) {
		if ($match->{result} =~ /[E\*]/) {
			$failed_matches++;
		}
	}
	
	# Determine tourney status.
	if ($intr_now || $intr_turn) {
		$state->{status} = "interrupted";
		print("Tourney interrupted.\n");
	} elsif ($failed_matches > 0) {
		$state->{status} = "finished,errors";
		print("Tourney finished with errors: ");
		printf("%d match%s %s not completed correctly.\n",
				$failed_matches,
				$failed_matches == 1 ? "" : "es",
				$failed_matches == 1 ? "was" : "were",
				$failed_matches == 1 ? "it" : "them");
	} else {
		$state->{status} = "finished";
		print("Tourney finished.\n");
	}

	# Finish.
	save_state();
	unlock_tourney();
}

sub worker {
	my ($ti, $match, $gamenr) = @_;

	my $matchnr1 = $match->{number};

	printf("Worker thread %d started (game %d/%d).\n",
			$ti, $matchnr1, $gamenr+1);
	my $r = run_game($match, $gamenr);
	printf("Worker thread %d finished (game %d/%d, result '%s').\n",
			$ti, $matchnr1, $gamenr+1, $r);
	$worker_running[$ti] = 0;

	return ($matchnr1, $gamenr, $r);
}

sub join_workers {
	my ($all) = @_; # all or only currently finished workers

	if ($all) {
		print("Waiting for all remaining worker threads...\n");
	}

	for (my $ti = 0; $ti < $nr_worker_threads; $ti++) {
		if (!defined($worker_threads[$ti])) {
			next;
		} elsif (!$all && $worker_running[$ti]) {
			next;
		}

		# join thread and get result
		printf("Waiting for worker thread %d...\n", $ti);
		my ($matchnr1, $gamenr, $r) = $worker_threads[$ti]->join();
		$worker_threads[$ti] = undef;
		printf("Joined worker thread %d (game %d/%d, result '%s').\n",
				$ti, $matchnr1, $gamenr+1, $r);

		# save result
		foreach my $match (@{$state->{matches}}) {
			if ($matchnr1 == $match->{number}) {
				substr($match->{result}, $gamenr, 1) = $r;
			}
		}
		save_state();
	}
}

sub run_game {
	my ($match, $gamenr) = @_;
	my $matchnr1 = $match->{number};

	# We must alternate between white and black
	my $w;
	my $b;
	if ($gamenr % 2 == 0) {
		$w = 'white';
		$b = 'black';
	} else {
		$w = 'black';
		$b = 'white';
	}
	my $white = $match->{$w};
	my $black = $match->{$b};

	# shortcuts
	my $white_name = $state->{engines}->{$white}->{name};
	my $black_name = $state->{engines}->{$black}->{name};

	printf("[%s] Starting game %d/%d: %s vs. %s\n",
			format_time(time()),
			$matchnr1, $gamenr+1, $white_name, $black_name);


	my ($logfile, $pgnfile) = get_logpgn_name($matchnr1, $gamenr+1);

	# Move away old PGN and log files.
	if (-e $logfile || -e $pgnfile) {
		moveaway_logpgn($matchnr1, $gamenr+1);
	}
	my $pgntmpfile = "$pgnfile.tmp";

	my $xboard_args = "-debug -xexit";
	$xboard_args .= " -thinking";
	$xboard_args .= " -xponder";
	$xboard_args .= " -mg 1";
	$xboard_args .= sprintf(" -tc %d -inc %d -mps %d",
			$state->{settings}->{time_per_session},
			$state->{settings}->{time_increment},
			$state->{settings}->{moves_per_session});
	$xboard_args .= " -sgf $pgntmpfile";
	$xboard_args .= sprintf(" -fcp '%s %s' -fd '%s' -scp '%s %s' -sd '%s'",
			$state->{engines}->{$white}->{bin},
			$state->{engines}->{$white}->{args},
			$state->{engines}->{$white}->{dir},
			$state->{engines}->{$black}->{bin},
			$state->{engines}->{$black}->{args},
			$state->{engines}->{$black}->{dir});
	$xboard_args .= " $state->{settings}->{xboard_user_args}";
	
	#
	# Run xboard.
	#
	my $xboard_path = $state->{settings}->{xboard_path};
	my $xboard_command = "$xboard_path $xboard_args";
	if ($state->{settings}->{winboard}) {
		# winboard
		print("Running winboard: $xboard_command\n") if ($debug);
		my $ret = system("$xboard_command");
		sleep 2;
		move("winboard.debug", $logfile)
				or print("Warning: moving winboard.debug to"
						. " $logfile failed: $!\n");
		$ret >>= 8;
		if ($ret != 0) {
			printf("Error: winboard exited with $ret.\n");
			return 'E';
		}
	} else {
		# xboard
		print("Running xboard: $xboard_command\n") if ($debug);
		my $ret = system("$xboard_command > $logfile 2>&1");
		$ret >>= 8;
		if ($ret != 0) {
			printf("Error: xboard exited with $ret.\n");
			return 'E';
		}
	}

	#
	# Get result from PGN file.
	# TODO update comment
	# 
	# We silently assume that the PGN is in export format, i.e.
	# the 'Result' tag appears after the corresponding 'White'
	# and 'Black' tags.
	#
	my $result;
	if (!open(PGNTMP, $pgntmpfile)) {
		print("Error: Cannot open $pgntmpfile for reading: $!\n");
		return 'E';		
	}
	if (!open(PGNFIXED, ">$pgnfile")) {
		print("Error: Cannot open $pgnfile for writing: $!\n");
		return 'E';
	}
	
	while (<PGNTMP>) {
		s/\n//;
		s/\r//;
		chomp;

		my $fixedline;
		
		if (/^\[White *"?([^"]*)"? *\]/) {
			if ($white_name ne $1)  {
				print("$pgnfile: White player names"
					. " don't match: should be"
					. " '$white_name', but is: '$1'."
					. " FIXED\n") if ($debug);
				$fixedline = "[White \"$white_name\"]";
			} else {
				$fixedline = $_;
			}
		} elsif (/^\[Black *"?([^"]*)"? *\]/) {
			if ($black_name ne $1)  {
				print("$pgnfile: Black player names"
					. " don't match: should be"
					. " '$black_name', but is: '$1'."
					. " FIXED\n") if ($debug);
				$fixedline = "[Black \"$black_name\"]";
			} else {
				$fixedline = $_;
			}
		} elsif (/^\[Result *"?([^"]*)"? *\]/) {
			if (defined($result)) {
				print("Warning: Result already defined.\n");
			}
			$result = $1;
			$fixedline = $_;
		} else {
			$fixedline = $_;
		}

		print(PGNFIXED $fixedline . "\n");
	}
	close(PGNTMP);
	close(PGNFIXED);
	unlink($pgntmpfile) or die("cannot unlink $pgntmpfile: $!");

	printf("[%s] Game %d/%d finished: %s vs. %s  %s\n",
			format_time(time()),
			$matchnr1, $gamenr+1, $white_name, $black_name,
			$result);
			
	if ($result eq "1-0") {
		if ($w eq 'white') {
			return '1';
		} else {
			return '0';
		}
	} elsif ($result eq "0-1") {
		if ($w eq 'white') {
			return '0';
		} else {
			return '1';
		}
	} elsif ($result eq "1/2-1/2") {
		return '=';
	} elsif ($result eq "*") {
		return '*';
	} else {
		print("Error: $pgnfile: Unknown result code: '$result'.\n");
		return 'E';
	}
}


###############################################################################
# Utility functions
###############################################################################

#
# Generate player list.
# If no players we selected in the configuration file, add all
# known engines as players.
#
sub generate_playerlist {
	if (@{$state->{players}} == 0) {
		print("No players selected, all known engines will be added"
				. " as players.\n");
		push(@{$state->{players}}, sort(keys(%{$state->{engines}})));
	}
}

#
# Check player list.
# Check if we have an engine configuration for each player.
#
sub check_playerlist {
	foreach my $p (@{$state->{players}}) {
		if (!defined($state->{engines}->{$p})) {
			print("Error: No engine configuration for"
					. " player '$p'\n");
			return 0;
		}
	}
	return 1;
}

sub get_logpgn_name {
	my ($matchnr1, $gamenr1) = @_;

	my $pgnfile = sprintf("$tourney_name.match-%03d-%03d.pgn",
			$matchnr1, $gamenr1);
	my $logfile = sprintf("$tourney_name.match-%03d-%03d.log",
			$matchnr1, $gamenr1);
	
	return ($logfile, $pgnfile);
}

sub moveaway_logpgn {
	my ($matchnr1, $gamenr1) = @_;
	
	my ($logfile, $pgnfile) = get_logpgn_name($matchnr1, $gamenr1);
	
	my $i = 0;
	my $logfile_old;
	my $pgnfile_old;
	do {
		$logfile_old = "$logfile.$i";
		$pgnfile_old = "$pgnfile.$i";
		$i++;
	} while (-e $logfile_old || -e $pgnfile_old);
	
	if (-e $logfile) {
		print("renaming '$logfile' in '$logfile_old'\n") if ($debug);
		move($logfile, $logfile_old) or die("cannot move '$logfile' to"
						. " '$logfile_old': $!\n");
	}

	if (-e $pgnfile) {
		print("renaming '$pgnfile' in '$pgnfile_old'\n") if ($debug);
		move($pgnfile, $pgnfile_old) or die("cannot move '$pgnfile' to"
						. " '$pgnfile_old': $!\n");
	}
}

sub get_length_of_longest_engine_name {
	my $maxlen = 0;

	foreach my $p (keys(%{$state->{engines}})) {
		my $l = length($state->{engines}->{$p}->{name});
		if ($l > $maxlen) {
			$maxlen = $l;
		}
	}

	return $maxlen;
}

#
# Try to find out the real name of the engine,
# which is reported by 'feature myname="..."'.
#
sub get_engine_realname {
	my ($engine) = @_;

	my $dir = $state->{engines}->{$engine}->{dir};
	my $bin = $state->{engines}->{$engine}->{bin};
	my $args = $state->{engines}->{$engine}->{args};
	my $name;

	print("get_engine_realname(): dir='$dir', bin='$bin', args='$args'\n")
				      if ($debug);

	# We must catch SIGPIPE, in case the process created by open3
	# failes to start or exists unexpectedly. 
	local $SIG{PIPE} = sub { print("Error: '$bin': $!\n"); };

	my $pid;
	my $batfile;	# for windows
	if ($state->{settings}->{winboard}) {
		# Because there is no portable way to put multiple commands
		# in one line, we write then into a .bat file first.
		$batfile = "$tourney_name.bat";
		open(FH, ">$batfile")
			or die("Error: Cannot open $batfile for writing: $!\n");
		print(FH "cd $dir\n");
		print(FH "$bin $args\n");
		close(FH);
		
		eval {
			$pid = open3(*FHO, *FHI, *FHI, $batfile);
		};
		if ($@ =~ /^open2:/) {
			die("open2 failed: $@\n");
		}

		# batfile is removed below, after process is terminated.
	} else {
		eval {
			$pid = open3(*FHO, *FHI, *FHI,
					"cd '$dir' && $bin $args");
		};
		if ($@ =~ /^open2:/) {
			die("open2 failed: $@\n");
		}
	}
	
	print(FHO "xboard\nprotover 2\n");
	print(">$bin: xboard\nprotover 2\n") if ($debug);
	
	while (<FHI>) {
		print("<$bin: $_") if ($debug);
		chomp;
		if (/^feature /) {
			if (s/.*myname=\"([^"]*)\".*/$1/) {
				$name = $_;
				last;
			} elsif (/done=1/) {
				last;
			}
		} elsif (/^Illegal move:.*protover/
				|| /Error.*protover/) {
			print("Warning: '$engine' does not support xboard"
				. " protocol version 2. Expect problems.\n");
			last;
		}			
	}
	
	print(FHO "quit\n");
	print(">$bin: quit\n") if ($debug);
	while (<FHI>) {
		print("<$bin: $_") if ($debug);
	}

	close(FHI);
	close(FHO);

	kill($pid);
	waitpid($pid, 0);

	if ($state->{settings}->{winboard}) {
		unlink($batfile) or die("cannot unlink $batfile: $!\n");
	}

	
	if (!defined($name)) {
		# For engines that don't tell their name with
		# 'feature myname=...', xboard just uses engine
		# binary name.
		$name = basename($bin);
		print("Warning: Could not find out real name of '$engine',"
				. " using '$name'\n");
	}	
	
	return $name;
}

sub format_time {
	my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)
		= localtime($_[0]);	 

	return sprintf("%02d:%02d", $hour, $min);
}


###############################################################################
# Module loaded successfully.
1;