#!/usr/bin/perl

=head1 NAME

pairingtable - Show player scoregroups for next round of swiss tournament

=head1 VERSION

0.04

=cut

our $VERSION = '0.04';

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 (%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 $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 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, it will show pairgroups for the next round following the highest existing 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:
