#!/usr/bin/perl

=head1 NAME

pairingtable - Show player scoregroups for next round of swiss tournament

=head1 VERSION

Version 0.04

=cut

our $VERSION = '0.04';

use strict;
use warnings;

use YAML qw/LoadFile DumpFile/;
use List::MoreUtils qw/all/;

use Games::Tournament::Swiss::Config;

my $swiss = Games::Tournament::Swiss::Config->new;

my $league = LoadFile "./league.yaml";
die 'round.yaml already exists' if -e 'round.yaml';
my $roles = $league->{roles} || [qw/White Black/];
my $scores = $league->{scores} ||
	{ win => 1, loss => 0, draw => 0.5, absent => 0, bye => 1 };
my $firstround = $league->{firstround} || 1;
my $algorithm = $league->{algorithm} || 'Games::Tournament::Swiss::Procedure::FIDE';
my $abbrev = $league->{abbreviation} ||
    { W => 'White', B => 'Black', 1 => 'Win', 0 => 'Loss',
	0.5 => 'Draw', '=' => 'Draw'  };

$swiss->frisk($scores, $roles, $firstround, $algorithm, $abbrev);

$Games::Tournament::Swiss::Config::firstround = $firstround;
%Games::Tournament::Swiss::Config::scores = %$scores;
@Games::Tournament::Swiss::Config::roles = @$roles;
$Games::Tournament::Swiss::Config::algorithm = $algorithm;

require Games::Tournament::Swiss;
require Games::Tournament::Contestant::Swiss;
require Games::Tournament::Card;

my $tourney;
my $table;
my $players;
my $games;

## Make it possible to pass round number as an argument to this script.
## If no argument is given then number of current round is computed 
## by looking what's the last score file.

my @rounds;
if (($ARGV[0]) and ($ARGV[0] =~ /^\d+$/)) {
    @rounds = (1..$ARGV[0]);
} else {
    for my $number ( glob ('./*') ) {
	push @rounds, $number if -d $number and $number =~ m/\/(\d+)$/
	    and -e "./scores/$number.yaml";
    }
}

for my $round ( @rounds )
{
    next unless glob( "./$round/*" );
	$tourney = LoadFile "./$round/tourney.yaml";
	$players = LoadFile qq{./$round/player.yaml};
	$games = LoadFile "./$round/matches.yaml";
	if ($tourney->unmarkedCards(@$games))
	{
		my $results = LoadFile( "./scores/$round.yaml" );
    my @tables;
    if ( @tables = (keys %$results) and all {ref} @{$results}{@tables} ) {
	for my $table ( @tables ) {
	    for my $player ( keys %{$results->{$table}} ) {
		my $result = $results->{$table}->{$player};
		if ( exists $scores->{$result} )
		{ $results->{$player} = $result; }
		elsif ( $abbrev->{$result} )
		{ $results->{$player} = $abbrev->{$result}; }
		else { die
"Player $player on table $table in round $round got $result?";
		}
	    }
	}
    }
		for my $game ( @$games )
		{
			my (%score, %result);
			my $total;
			my @roles =  keys %{ $game->contestants }; 
			my @contestants = map {$_->id} values
							%{$game->{contestants}};
			for my $role ( @roles )
			{
				my $player = $game->contestants->{$role};
				my $result = $results->{$player->name};
				warn "$player->{name} got $result in round $game->{round}"
							unless defined $result;
				$result{$role} = $result;
				$score{$role} =
				    $role =~ m/Bye/i ? $scores->{bye}
				  : $result =~ m/Win/i ? $scores->{win}
				  : $result =~ m/Draw/i ? $scores->{draw}
				  : $result =~ m/Loss/i ? $scores->{loss}
				  : $result =~ m/Absent/i ? $scores->{absent}
				  : "Error";
				$total += $score{$role};
			}
			die "total scores in round $round game with players @contestants not $total"
			unless $total == $scores->{win} + $scores->{loss} or 
			$total == 2 * $scores->{draw} or
			$total == $scores->{draw} + $scores->{absent} or
			$total == 2 * $scores->{absent};
			$game->result( \%result );
		}
	}
	$tourney->collectCards(@$games);
	# $tourney->updateScores($round);
	for my $player ( @$players )
	{
		my $id = $player->id;
		$table->{$id}->{id} = $id;
		my $game = $player->findCard( @$games );
		my $opponent = $player->myOpponent($game) || 
			Games::Tournament::Contestant->new(name=>"Bye",id=>"-");
		$table->{$id}->{opponents} .= $opponent->id . ",";
		my $role = $game->myRole($player);
		if ( $role eq 'Bye' ) { $role = '-'; }
		else { $role =~ s/^(.).*$/$1/; }
		$table->{$id}->{roles} .= $role;
	}
}

my %brackets = $tourney->formBrackets;
my $playerN = 0;

print "
		Round @{[$#rounds+2]} Pairing Groups
-------------------------------------------------------------------------
Place  No  Opponents     Roles     Float Score
";
for my $index ( reverse sort keys %brackets )
{
	$playerN++;
	my $place = $playerN;
	my @members = @{$brackets{$index}->members};
	$place .= '-' . ($playerN+$#members) if $#members;
	$playerN += $#members;
	print "$place\n";
	foreach my $member ( @members )
	{
		my $id = $member->id;
		chop $table->{$id}->{opponents};
		my $floats = $member->floats;
		my $float = '';
		$float = 'd' if $floats->[-2] and $floats->[-2] eq 'Down';
		$float = 'u' if $floats->[-2] and $floats->[-2] eq 'Up';
		$float .= 'D' if $floats->[-1] and $floats->[-1] eq 'Down';
		$float .= 'U' if $floats->[-1] and $floats->[-1] eq 'Up';

	# no warnings;
	format STDOUT =
@<<<<< @<< @<<<<<<<<<<<<< @<<<<<<<< @<< @<<<
"\t", $id,  $table->{$id}->{opponents}, $table->{$id}->{roles}, $float, $member->score
.
	write;
	# use warnings;
	}
}

__END__

=head1 SYNOPSIS

pairingtable

Options:

--help            This help message

--man            A man page

=head1 DESCRIPTION

B<pairingtable> shows the scoregroups that players with equal scores fall into, allowing calculation of who will play who in the next round. Included is place so far, opponents each player has already met, the roles in the previous rounds, downfloating (and upfloating) in the previous round (D) and in the round before the previous round (d).

Run it in the directory league.yaml is in and pass a round number, it will show pairgroups for that round. If no number is passed, the next round is the round following the highest existing one in the directory. Run it in a round directory, it will show pairgroups for the round after that round.

=cut

# vim: set ts=8 sts=4 sw=4 noet:
