view release on metacpan or  search on metacpan

lib/Games/Tournament.pm  view on Meta::CPAN

=cut

sub unmarkedCards {
    my $self  = shift;
    my @games = @_;
    my @unfinished;
    for my $game (@games) {
        my $contestants = $game->contestants;
        my $result      = $game->result;
        push @unfinished, $game
          unless (
            ( keys %$contestants == 1 and $result->{Bye} =~ m/Bye/i )
            or $result->{ (ROLES)[0] } and $result->{ (ROLES)[1] }
            and (
                (
                        $result->{ (ROLES)[0] } eq 'Win'
                    and $result->{ (ROLES)[1] } eq 'Loss'
                )
                or (    $result->{ (ROLES)[0] } eq 'Loss'
                    and $result->{ (ROLES)[1] } eq 'Win' )
                or (    $result->{ (ROLES)[0] } eq 'Draw'
                    and $result->{ (ROLES)[1] } eq 'Draw' )
            )
          );
    }
    return @unfinished;
}


=head2 dupes

	$games = $tourney->dupes(@grandmasters)

Returns an anonymous array, of the games in which @grandmasters have met. Don't forget to collect scorecards in the appropriate games first! (Assumes players do not meet more than once!)

=cut

sub dupes {
    my $self    = shift;
    my @players = @_;
    my @ids     = map { $_->id } @players;
    my $games   = $self->play;
    my @dupes;
    map {
        my $id = $_;
        map { push @dupes, $games->{$id}->{$_} if exists $games->{$id}->{$_}; }
          @ids;
    } @ids;
    return \@dupes;
}


=head2 updateScores

 @scores = $tourney->updateScores;

Updates entrants' scores for the present (previous) round, using $tourney's play (ie games played) field. Returns an array of the scores in order of the player ids (not at the moment, it doesn't), dying on those entrants who don't have a result for t...

=cut

sub updateScores {
    my $self    = shift;
    my $players = $self->entrants;
    my $round   = $self->round;
    my $games   = $self->play;
    my @scores;
    for my $player (@$players) {
        my $id     = $player->id;
        my $oldId  = $player->oldId;
        my $scores = $player->scores;
        my $card   = $games->{$round}->{$id};
        die "Game in round $round for player $id? Is $round the right round?"
          unless $card
          and $card->isa('Games::Tournament::Card');
        my $results = $card->{result};
        die @{ [ keys %$results ] } . " roles in player ${id}'s game?"
          unless grep { $_ eq (ROLES)[0] or $_ eq (ROLES)[1] or $_ eq 'Bye' }
          keys %$results;
        eval { $card->myResult($player) };
        die "$@: Result in player ${id}'s $card game in round $round?"
          if not $card or $@;
        my $result = $card->myResult($player);
        die "$result result in $card game for player $id in round $round?"
          unless $result =~ m/^(?:Win|Loss|Draw|Bye|Forfeit)/i;
        $$scores{$round} = $result;
        $player->scores($scores) if defined $scores;
        push @scores, $$scores{$round};
    }
    $self->entrants($players);
    # return @scores;
}


=head2 randomRole

 ( $myrole, $yourrole ) = randomRole;

This returns the 2 roles, @Games::Tournament::roles in a random order.

=cut

sub randomRole {
    my $self     = shift;
    my $evenRole = int rand(2) ? (ROLES)[0] : (ROLES)[1];
    my $oddRole  = $evenRole eq (ROLES)[0] ? (ROLES)[1] : (ROLES)[0];
    return ( $evenRole, $oddRole );
}


=head2 play

	$tourney->play

Gets the games played, keyed on round and id of player. Also sets, but you don't want to do that.

=cut

sub play {
    my $self = shift;
    my $play = shift;
    if ( defined $play ) { $self->{play} = $play; }