#===============================================================================
#
#         FILE:  Games::Go::AGA::DataObjects::Tournament.pm
#
#        USAGE:  use Games::Go::AGA::DataObjects::Tournament;
#
#      PODNAME:  Games::Go::AGA::DataObjects::Tournament
#     ABSTRACT:  models AGA register.tde file information
#
#       AUTHOR:  Reid Augustin (REID), <reid@lucidport.com>
#      COMPANY:  LucidPort Technology, Inc.
#      CREATED:  11/19/2010 03:13:05 PM PST
#===============================================================================


use strict;
use warnings;

package Games::Go::AGA::DataObjects::Tournament;

use Mouse;
use parent 'Games::Go::AGA::DataObjects::Register';
use Games::Go::AGA::DataObjects::Round;

use Carp;
use IO::File;
use IO::String;

our $VERSION = '0.107'; # VERSION

# public attributes
#   has 'rounds'   => (
#       isa => 'ArrayRef[Games::Go::AGA::DataObjects::Round]',
#       is => 'ro',
#       default => sub { [] }
#   );

# Note: the change callback shouldn't really be necessary since
# Directives are changed by the Directives object and player data is
# changed by the Player object.  But it might be convenient...
has 'change_callback' => (
    isa => 'Maybe[CodeRef]',
    is => 'rw',
    default => sub { sub { } }
);

sub BUILD {
    my ($self) = @_;
    $self->{rounds} = [ undef ];    # rounds start at 1
}

sub changed {
    my ($self) = @_;

    &{$self->change_callback}($self) if ($self->{change_callback});
}

sub add_round {
    my ($self, $round_num, $round, $replace) = @_;

    if ($round_num <= 0) {
        croak "Round number must be >= 1\n";
    }
    elsif ($round_num > 1 and       # allow round 1
            not defined $self->{rounds}[$round_num - 1]) {
        croak "Can't add round $round_num, previous round doesn't exist yet\n";
    }
    my $rm_round = $self->{rounds}[$round_num];
    if (defined $rm_round) {
        if ($replace) {
            # remove games from this stale round
            foreach my $game (@{$rm_round->games}) {
                $game->white->delete_game($game);
                $game->black->delete_game($game);
            }
        }
        else {
            croak "$round_num already exists\n";
        }
    }
    $self->{rounds}[$round_num] = $round;
    # $self->changed; # rounds are recorded in N.tde files, not in register.tde
}

sub games  {
    my ($self, $round_num) = @_;

    $round_num = @{$self->{rounds}} if (not defined $round_num);
    my @games;
    foreach my $r_num (0 .. $round_num) {
        my $round = $self->{rounds}[$r_num];
        next if (not $round);
        push @games, $round->games;
    }
    return wantarray
        ?  @games
        : \@games;
}

sub rounds  {
    my ($self) = @_;

    return $#{$self->{rounds}};  # we don't count 0
}

sub round {
    my ($self, $round_num) = @_;

    if (not defined $self->{rounds}[$round_num]) {
        croak "Round $round_num doesn't exist\n";
    }
    return $self->{rounds}[$round_num];
}

sub send_to_AGA {
    my ($self, $fd) = @_;

    if (not $fd) {
        $fd = IO::String->new() or die "Failed to create IO::String\n";
    }

    $fd->printf("TOURNEY %s\n",
        $self->get_directive_value('TOURNEY'));

    my $date = $self->get_directive_value('DATE');
    my ($start, $finish) = $date =~ m/^(\S+)[\-\s]+(\S+)$/;
    $start  ||= $date;
    $finish ||= $start;
    $start  =~ s/\D/\//g;     # use slash date notation
    $finish =~ s/\D/\//g;
    $fd->print("     start=$start\n"),
    $fd->print("    finish=$finish\n"),

    $fd->printf("     rules=%s\n",
        $self->get_directive_value('RULES'));
    $fd->print("\nPLAYERS\n");

    # print player info
    my $name_width = 5;
    for my $player ($self->players) {
        $name_width = length($player->full_name)
            if (length($player->full_name) > $name_width);
    }

    for my $player ($self->players) {
        $fd->printf("%9.9s %*.*s %s\n",
            $player->id,
            $name_width,
            $name_width,
            $player->full_name,
            $player->rating,
        );
    }

    # print games with results
    $fd->print("\nGAMES\n");
    foreach my $game ($self->games) {
        if ($game->winner) {
            my $result = ($game->winner->id eq $game->white->id) ? 'W' : 'B';
            $fd->printf("%9.9s %9.9s $result %s %s\n",
                $game->white->id,
                $game->black->id,
                $game->handi,
                $game->komi,
            );
        }
    }
    $fd->print("\n");

    return $fd
}

# this really shouldn't be necessary.  Register and Directives will
#    fprint the register.tde files, and Round will fprint the N.tde files.
sub fprint {
    my ($self, $fh) = @_;

    $self->SUPER::fprint($fh);         # print the register.tde file
}

no Mouse;
__PACKAGE__->meta->make_immutable;

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Games::Go::AGA::DataObjects::Tournament - models AGA register.tde file information

=head1 VERSION

version 0.107

=head1 SYNOPSIS

    use Games::Go::AGA::DataObjects::Tournament;
    my $tournament = Games::Go::AGA::DataObjects::Tournament->new();

    my $rounds = $tournament->rounds;  # ref to the array of rounds

=head1 DESCRIPTION

Games::Go::AGA::DataObjects::Tournament models the information about a
American Go Association (AGA) go tournament.

Games::Go::AGA::DataObjects::Tournament isa Games::Go::AGA::DataObjects::Register
object with additional methods:

=over

=item $tournament->add_round($round_num, $round, [ 'replace' ] )

Adds a Games::Go::AGA::DataObjects::Round to the tournament as number B<$round_num>.
Throws an exception if B<$round_num> - 1 doesn't exist yet.  If B<'replace'> is
defined, all existing games from this B<$round_num> are removed from the
Games::Go::AGA::DataObjects::Players.

=item $tournament->rounds

Returns the number of rounds (round 0 never exists and is not counted).

=item $tournament->round($round_num)

Returns the Games::Go::AGA::DataObjects::Round object for round B<$round_num>.

=item $tournament->send_to_AGA( [ $fd ] )

Format the tournament data for sending to the AGA (ratings@usgo.org).

If B<$fd> is defined, it is printed to.  If not, it is created as a new
C<IO::String> object.  $<fd> is returned, so if B<$fd> is an C<IO::String>
object, the caller can acquire the string using B<$fd->string_ref> (see
C<perldoc IO::String>).

=back

=head1 SEE ALSO

=over

=item Games::Go::AGA

=item Games::Go::AGA::DataObjects

=item Games::Go::AGA::DataObjects::Register

=item Games::Go::AGA::DataObjects::Game

=item Games::Go::AGA::DataObjects::Player

=item Games::Go::AGA::Parse

=item Games::Go::AGA::Gtd

=back

=head1 AUTHOR

Reid Augustin <reid@hellosix.com>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2015 by Reid Augustin.

This is free software; you can redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.

=cut
