#!/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::Util qw/first/;
use List::MoreUtils qw/all/;

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

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

my $league = LoadFile "./league.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 $lineup;
my $games;

my @absentees = @{ $league->{absent} } if $league->{absent};
for my $member ( @{ $league->{member} } ) {
    next if grep {$member->{name} eq $_} @absentees;
    push @$lineup, Games::Tournament::Contestant::Swiss->new( %$member );
}

$tourney = Games::Tournament::Swiss->new(
		entrants => $lineup );
$tourney->assignPairingNumbers;

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";
    }
}

my $table;
for my $round ( @rounds )
{
    next unless glob( "./$round/*" );
    $tourney->round($round);
    $games = LoadFile "./$round/matches.yaml";
    if ($tourney->unmarkedCards(@$games)) {
	my $results = LoadFile( "./scores/$round.yaml" );
	my @cards;
	if ( @cards = ( keys %$results ) and
		all { ref } @{$results}{@cards} ) {
	    for my $card (@cards) {
		for my $player ( keys %{ $results->{$card} } ) {
		    my $result = $results->{$card}->{$player};
		    if ( exists $scores->{lc $result} ) {
			$results->{$player} = $result;
		    }
		    elsif ( $abbrev->{$result} ) {
			$results->{$player} = $abbrev->{$result};
		    }
		    else {
			die
		"Player $player on table $card in round $round got $result?";
		    }
		}
	    }
	}
	for my $game (@$games) {
	    my ( %score, %result );
	    my $total;
	    my @contestants = $game->myPlayers;
	    for my $contestant (@contestants) {
		my $role = $game->myRole( $contestant );
		my $result = $results->{ $contestant->name };
		warn "$contestant->{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";
		my $player = first { $_->id eq $contestant->id} @$lineup;
		$player->{score} = exists $player->{score}?
			$player->{score} + $score{$role}: $score{$role};
		$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 );
	}
    }
    for my $player (@$lineup) {
        my $id = $player->id;
        $table->{$id}->{id} = $id;
        my $game = $player->findCard(@$games);
        if ( defined $game ) {
            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;
        }
        else {
            $table->{$id}->{opponents} .= "-,";
            $table->{$id}->{roles} .= "-";
	}
    }
}

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 [n]

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:
