gplayer

#! /usr/bin/perl -w

# Goat: Gentil Organisateur et Administrateur de Tournois
# Copyright (C) 2006-2024  Yves Rutschle
# 
# This program is free software; you can redistribute it
# and/or modify it under the terms of the GNU General Public
# License as published by the Free Software Foundation; either
# version 2 of the License, or (at your option) any later
# version.
# 
# This program is distributed in the hope that it will be
# useful, but WITHOUT ANY WARRANTY; without even the implied
# warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR
# PURPOSE.  See the GNU General Public License for more
# details.
# 
# The full text for the General Public License is here:
# http://www.gnu.org/licenses/gpl.html

=head1 NAME

 gplayer -- manage players in a tournament file

=head1 SYNOPSIS

 gplayer [--newtournament] [--no-getech] --add players.txt

 gplayer --del <player email>

 gplayer --update <email>
        [--email <new_email>]
        [--level <level>]

 gplayer --update <email> --license <license>

=head1 DESCRIPTION

B<gplayer> ("goat player") manages players in a tournament
file. It can be used to create a tournament from scratch,
add players, delete players, or update player fields.


=head1 OPTIONS

=over 4

=item C<--no-getech>

B<--no-getech> prevents downloading the echelle file.
Default is to download the echelle file every time players
are added.

=item C<--testing>

Do not download echelle. This may disable other behaviour in
the future if required for the test suite, and should not be
used. 

=back

=head1 COMMANDS

At least one command is mandatory.

=over 4

=item C<--add>

This adds one or more new players. It can be used at any
time during the tournament: new players will get paired in
subsequent rounds, and will appear as having not played in
previous rounds.

Players are added from a simple text file that contains one
line for each player (or from I<stdin>)

The format of each line is as follows:

 <full name> <<email address>> # additional information

Additional information can be the licence number (useful in
case there are several players with the same name) or the
level (useful if a player hasn't played yet).

For example:

 Joe Bloggs <joe@blogs.net> # 0242149 3k

This will register Joe Bloggs, licence number 0242149, at
250 points. In most cases, the additional information does
not need to be specified.

B<gplayer> knows how to parse B<mutt> alias lines directly,
so B<mutt> users just need to press 'C<a>' when reading the
mail of a player.  This registering method has three
advantages: there can be no mistake in e-mail addresses,
it's simple to do from the mail program, and the operator is
left with a mutt-usable list of players for further
mass-mailing.

=item C<--del> <email>

This removes a player from subsequent rounds: the
player will no longer be paired. Past games remain recorded
and the player still appears in the full results.

=item C<--update> <email> <license>

This updates the player registered with C<email>, using data
from the current Echelle file from the player with the
specified license number. This will update the name, club,
and registering level of the player.

=back

=cut

# Processes registrations:
# - Input file: muttrc-syntax alias file; echelle file
# - Output file: Tournament object in file toperm

use strict;
use locale;
use Getopt::Long;
use Pod::Usage;

use Tournament;
use GoatLib;
use GoatConfig;

my ($testing, $param_no_getech, $help, $param_newtournament, 
$param_add, $param_del, $param_update, $param_email,
$param_license, $param_level);

GetOptions(
    'test' => \$testing,
    'help' => \$help,
    'no-getech' => \$param_no_getech,
    'newtournament' => \$param_newtournament,
    'add' => \$param_add,
    'del=s' => \$param_del,
    'update=s' => \$param_update,
    'email=s' => \$param_email,
    'license=s' => \$param_license,
    'level=s' => \$param_level,
) or die pod2usage();

die pod2usage(-verbose=>3) if defined $help;

################################################################################
sub add {
    my ($t) = @_;

    my @registered;

    # Download/update echelle
    $t->update_ech() unless $testing or $param_no_getech;

    while (<>) {
        next if /^#/ or /^$/;
        $_ = Encode::decode('UTF-8', $_);

        my $player = FFGPlayer->new_from_alias($_, $t->ech_file());
        next unless defined $player;

        unless ($player->is_licensed($TOURNAMENT_LICENSES)) {
            warn $player->fullname.": player license: ".$player->status.
                " (".$player->status_text.") is not allowed.\n";
        }

        push @registered, $player;
    }

    # Sort by level
    @registered = sort { $b->level <=> $a->level } @registered;

    foreach my $p (@registered) {
        $t->add_player($p);
        warn "registering ".$p->fulladdress."\n";
    }
    warn "Registered ".(scalar @registered)." players.\n";
}
################################################################################
sub del {
    my ($t, $email) = @_;
    my $p = $t->find_player_by_email($email);
    die "player $email not found\n" unless defined $p;

    $t->del_player($p);
    print "deleting ".$p->fullname." <".$p->email.">\n";
}
################################################################################
sub update_from_params {
    my ($p, $new_email, $new_level) = @_;

    $p->email($new_email) if defined $new_email;
    $p->level($new_level) if defined $new_level;
}

sub update_from_echelle {
    my ($t, $p, $param_license) = @_;

    my @res = FFGPlayer::grep_echelle($t->ech_file(), "null", $param_license);
    die "Looking for $param_license finds ".scalar @res." results\n" if scalar @res != 1;

    my $new_p = new_from_ech FFGPlayer $res[0];
    die "player not found\n" unless defined $new_p;

    foreach my $field (qw/familyname givenname level status club/) {
        eval qq{
            do {
                my (\$old, \$new);
                \$old = \$p->$field;
                \$new = \$new_p->$field;
                if (\$old ne \$new) {
                    \$p->$field(\$new_p->$field);
                    warn "updating $field from \$old to \$new\\n";
                }
            }
        }
    };
}
################################################################################
# MAIN
################################################################################

my $t;
if ($param_newtournament) {
    # Tournament object
    $t = new Tournament (
        time=> 60,
        size=> 19,
        komi=> 7.5,
    );
} else {
    $t = load Tournament $TOURNAMENT_FILE;
}

if ($param_add) {
    add($t);
} elsif ($param_del) {
    del($t, $param_del);
} elsif ($param_update) {
    my $p = $t->find_player_by_email($param_update);
    die "player $param_update not found\n" unless defined $p;

    if (defined $param_license) {
        update_from_echelle($t, $p, $param_license);
    } elsif (defined $param_email or $param_level) {
        update_from_params($p, $param_email, $param_level);
    } else {
        die pod2usage(-verbose=>1);
    }
} else {
    die pod2usage(-verbose=>1);
}

$t->save($TOURNAMENT_FILE);