view release on metacpan or  search on metacpan

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

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

lib/Games/Tournament/Contestant/Swiss/Preference.pm  view on Meta::CPAN

=head2 update

	$pref->update( \@oldRoles  )

	Updates the difference (ie, the internal representation of preference) on the basis of the last role (and second-last role) in \@oldRoles. A minimal sanity check is performed. \@oldRoles is a history of roles in previous rounds, and it is expected o...

=cut

sub update {
    my $self     = shift;
    my $roles = shift;
    my $message = "Preference update: ";
    return unless $roles->[-1] and any { $roles->[-1] eq $_ } ROLES;
    my @reverseRoles = reverse @$roles;
    my $lastRole       = $reverseRoles[0];
    my $before         = $reverseRoles[1];
    my $oneBeforeThat = $reverseRoles[2];
    $message .= "3-game run as $lastRole\n" if $before and $oneBeforeThat and
		    $oneBeforeThat eq $before and $before eq $lastRole;

t/preference.t  view on Meta::CPAN

use Games::Tournament::Contestant::Swiss::Preference;

filters qw/lines chomp/;
filters { input => [ qw/updatepref/ ], expected => [ qw/array/ ] };

plan tests => 1 * blocks;

run_is_deeply input => 'expected';

sub updatepref {
	my $sign = shift;
	my $difference = shift;
	my $oldRoles = shift;
	my @oldRoles = split /,/, $oldRoles;
	my $lastrole = pop @oldRoles;
	@oldRoles = grep { my $role = $_;
				any { $role eq $_ } qw/Black White/ } @oldRoles;
	my @lastTwo;
	if ( @oldRoles > 1 )
	{