#!/usr/bin/perl

#
# Handle tournament player ordering.
#
#   - read in csv file
#   - order of columns is
#    <oder nro>|<player>|<army>|<current points>|<opponents>|<turn poi
+nts> ...
#
# by Henrikki Almusa, 2006
# Licenced under GPL, see http://www.gnu.org/licenses/gpl.html
#

use warnings;
use strict;

my @OPPONENTS = ();    # who has already played who
my %POINTS = ();    # current points for each player
my %PLAYERS = ();    # number -> player name
my $TABLE_ORD = 0;    # set to 1 for reverse order of tables
my @TABLES = ();    # tables that player has played in

my $NUM_COL = 0;
my $PLAYER_COL = 1;
my $POINT_COL = 3;
my $OPP_COL = 4;

# values, not really used though
my $POINT_DIFF = 10;    # try to get opponents within this point value
my $MAX_NAME_LEN = 0;    # for prettier printing

###
# subroutines
###

# comments can be in rows where:
#  - first cell is empty
#  - first cell starts with '#'
sub is_comment (;$) {
  local $_ = shift @_ || $_;
  $_ || return 1;
  m/^"?#/ || m/^$/ || m/^"?\t/ || return 0;
  return 1;
}

sub parse_opp ($;$) {
  my $player = shift @_;
  local $_ = shift @_ || $_;
  my @list = split (/\s?;\s+/,$_);
  $OPPONENTS[$player]{$_} = undef foreach (@list);
  return;
}

sub read_data ($) {
  my $fname = shift @_;
  local $_;

  open (INF,$fname) or die "Unable to open '$fname': $!";
  while (<INF>) {
    is_comment() && next;
    chomp;
    s/^"|"$//g;
    my @line = split (/"?\t"?/,$_,-1);
    parse_opp($line[$NUM_COL],$line[$OPP_COL]);
    $POINTS{$line[$NUM_COL]} = $line[$POINT_COL];
    $PLAYERS{$line[$NUM_COL]} = $line[$PLAYER_COL];
    # parse_opp($line[$NUM_COL],$line[$TABLE_COL]);
    $MAX_NAME_LEN = length($line[$PLAYER_COL]) > $MAX_NAME_LEN ? lengt
+h($line[$PLAYER_COL]) : $MAX_NAME_LEN;
  }
  if (keys (%PLAYERS) % 2) {
    die ("Not even number of players.\n");
  }
  close INF;
  return;
}

# This is stub for upkeeping the tables people have played in. 
# Would allow to keep people from playing in same tables one day.
sub get_table ($$) {
  my $ply_a = shift @_;
  my $ply_b = shift @_;
  local $_;
}

sub is_first_turn($) {
  my $fname = shift @_;
  local $_;
  my $ret = 1;

  open (INF,$fname) or die "Unable to open '$fname': $!";
  while (<INF>) {
    is_comment() && next;
    chomp;
    my @line = split (/"?\t"?/,$_,-1);
    !$line[$OPP_COL] && next;
    $ret = 0;
    last;
  }
  close INF;

  return $ret;
}

sub print_next_turn (@) {
  my $i = 1;

  print "\tplayer\ttable\n";
  foreach (@_) {
  my $player_a = $_->[0];
  my $player_b = $_->[2];
  print "$PLAYERS{$player_a} ($_->[1])\t$PLAYERS{$player_b} ($_->[3])\
+t",$i++,"\n";
  }

  return;
}

sub get_players_first_turn () {
  local $_;
  my %val = ();
  my @ret = ();

  foreach (keys %PLAYERS) {
    $val{$_}=rand(1);
  }
  my @ord = sort {$val{$a} <=> $val{$b}} keys %val;
  while (@ord) {
    push (@ret,[pop(@ord),0,pop(@ord),0]);
  }

  return @ret;
}
sub get_players_rest() {
  local $_;
  my @ret = ();
  my %selected = ();
  my $i = 0;

  my @points = sort {$b <=> $a} values %POINTS;
  my @players = sort {$POINTS{$b} <=> $POINTS{$a}} keys %POINTS;
  foreach my $cur (@points) {
    !$players[$i] && next;
    my ($opp,$tmp) = ("","");
    foreach ($i+1 .. $#points) {
      !$players[$_] && next;
      if (!exists($OPPONENTS[$players[$_]]{$players[$i]})) {
        $opp = $_;
        last;
      } elsif (!$tmp) {
        $tmp = $players[$_];
      }
    }
    $opp = $opp || $tmp;
    push (@ret, [$players[$i],$points[$i],$players[$opp],$points[$opp]
+]);
    delete($players[$i]);
    delete($players[$opp]);
  } continue { $i++; }

  return @ret;
}

###
# MAIN
###
my $inf = shift @ARGV;
my @pair = ();
read_data($inf);

if (is_first_turn($inf)) {
  @pair = get_players_first_turn();
} else {
  @pair = get_players_rest();
}

print_next_turn(@pair);

exit;
[download]