view release on metacpan or  search on metacpan

t/preference.t  view on Meta::CPAN

#!/usr/bin/perl

use lib qw/t lib/;

use strict;
use warnings;
# use Games::Tournament::Swiss::Test -base; 
use Test::Base -base; 
use List::MoreUtils qw/any/;

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 )
	{
		$lastTwo[1] = $oldRoles[-1];
		$lastTwo[0] = $oldRoles[-2];
	}
	elsif ( @oldRoles > 1 ) {
		$lastTwo[0] = $oldRoles[-1];
	}
	else { @lastTwo = (); }
	my $pref = Games::Tournament::Contestant::Swiss::Preference->new(
		sign => $sign, difference => $difference, lastTwo => \@lastTwo);
	$pref->update(  [ @oldRoles, $lastrole ] );
	my $lastTwo = join ',', @{ $pref->lastTwo };
	return [ $pref->role, $pref->strength, $lastTwo ];
}

__END__

=== http://chesschat.org/showthread.php?t=7139 Player 5
--- input
White
2
White,White,None
--- expected
Black
Absolute
White,White

=== http://chesschat.org/showthread.php?t=7139 Player 5 again
--- input
White
0
Black,White,None
--- expected
Black
Mild
Black,White

=== http://chesschat.org/showthread.php?t=7139 Player 6
--- input
Black
1
Black,None,Black
--- expected
White
Absolute
Black,Black

=== http://chesschat.org/showthread.php?t=7139 Player 6 again
--- input
White
1