#!/usr/bin/perl

use strict;
use warnings;

use YAML qw/LoadFile DumpFile/;

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/Black White/];
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 $firstround = $swiss->frisk($firstRound);
$scores = $swiss->frisk($scores);
$roles = $swiss->frisk($roles);
$algorithm = $swiss->frisk($algorithm);

$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;

my @rounds;
for my $file ( glob ('./*') )
{
    push @rounds, $1 if -d $file and $file =~ m/\/(\d+)$/ and
							    glob( "./$file/*" );
}
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" );
		for my $game ( @$games )
		{
			my %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->id};
				$total += $result;
				$result{$role} =
					$role eq 'Bye'? $player
				      : $result == $scores->{win}    ? 'Win'
				      : $result == $scores->{draw}   ? "Draw"
				      : $result == $scores->{loss}   ? "Loss"
				      : $result == $scores->{absent} ? 'Absent'
				      : "Error";
			}
			die "total scores in round $round game with players @contestants not 1" if $total != 1;
			$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 $bracket ( @brackets )
{
	$playerN++;
	my $place = $playerN;
	my @members = @{$bracket->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 = 'D' if $floats->[-1] and $floats->[-1] eq 'Down';
		$float .= 'u' if $floats->[-2] and $floats->[-2] eq 'Up';
		$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 NAME

pair - Pair players for the next round of a swiss tournament

=head1 SYNOPSIS

pair

Options:

--help            This help message

--man            A man page

--id 9598457	Id of person claiming these beans to be theirs

--name Momotaro	Name of person claiming these beans to be theirs

--session first	The part of the semester in which the beans were won

--team Gray	The team to which the claimant belongs

--league m/j	The league to which the claimant belongs

--beans 75	Number of beans they are asking to be recorded 

=head1 OPTIONS

=over 8

=item B<-id>

Id of person claiming these beans to be theirs.

=item B<-name>

Name of person claiming these beans to be theirs.

=item B<-league>

The league to which the redeemer belongs

=item B<-session>

The session in which the beans were won.

=item B<-team>

The team to which the claimant belongs.

=item B<-beans>

Number of beans they are asking to be recorded.

=back

=head1 DESCRIPTION

B<pair> tallies beans that students have earned for classwork and are redeeming and stores them in beans.yaml as a total, logging their entry in beans.log. The separate script, B<grades> adds the total (divided by 5) to homework, midterm and final scores and outputs the grade so far.

The configuration file, league.yaml, in the directory above contains tournament entrants, series, members fields.

=cut

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