Algorithm-Voting

 view release on metacpan or  search on metacpan

lib/Algorithm/Voting/Plurality.pm  view on Meta::CPAN

=head2 $box->validate_ballot($ballot)

If this election is limited to a specific list of candidates, this method will
C<die()> if the candidate on C<$ballot> is not one of them.

=cut

sub validate_ballot {
    my ($self, $ballot) = @_;
    # if this ballot box has a list of "valid" candidates, verify that the
    # candidate on this ballot is one of them.
    if ($self->candidates) {
        unless (grep { $_ eq $ballot->candidate } $self->candidates) {
            die "Invalid ballot: candidate '@{[ $ballot->candidate ]}'",
                " is not on the candidate list";
        }
    }
}

=head2 count

t/sortition/01-key.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More 'no_plan';
use Test::Exception;
use Digest::MD5 'md5_hex';

my $avs = 'Algorithm::Voting::Sortition';

use_ok($avs);

# verify that things "stringify" as expected
{
    is($avs->stringify("foo"),"foo.");
    is($avs->stringify(["foo"]),"foo.");
    is($avs->stringify(['a','b','c']),"a.b.c.");
    is($avs->stringify(['a','c','b']),"a.b.c.");
    is($avs->stringify([1,2,3,4]),"1.2.3.4.");
    is($avs->stringify([4,3,2,1]),"1.2.3.4.");
    is($avs->stringify({a => 1}),"a:1.");
    is($avs->stringify({a => 1, b => 2}),"a:1.b:2.");
}

# can only stringify arrayrefs and hashrefs for now
dies_ok { $avs->stringify(\"fiddle-dee-dee") } "can't stringify scalarrref";

# verify that class method "make_keystring" works correctly
{
    my $x = [1,2,3];
    my $y = [1,3,2];
    my @tests = (
        [ [ $x ] => q(1.2.3./) ],
    );
    foreach my $i (0 .. $#tests) {
        my @in = @{ $tests[$i][0] };
        my $out = $tests[$i][1];
        is($avs->make_keystring(@in),$out);
    }
}

# verify that the keystring() method works correctly 
{
    my $s = $avs->new(candidates => ['a'..'e']);
    $s->source(1 .. 4);
    is($s->keystring(), q(1./2./3./4./));
    is($s->keystring(), q(1./2./3./4./));
    is($s->keystring(), q(1./2./3./4./));
}

# make sure the example source data from RFC3797 stringifies correctly
{

t/sortition/04-seq.t  view on Meta::CPAN

use strict;
use warnings;
use Test::More 'no_plan';
use Test::Exception;
use Digest::MD5 'md5_hex';

my $avs = 'Algorithm::Voting::Sortition';

use_ok($avs);

# verify that we can generate custom sequences by overrriding digest()
{
    no warnings qw/ once redefine /;
    local *Algorithm::Voting::Sortition::digest = sub { return "ffff"; };
    local *Algorithm::Voting::Sortition::n      = sub { return 5 };
    my $s = $avs->new(candidates => ['a'..'e']);
    is_deeply( [ $s->seq ], [ (0xffff) x 5 ] );
}

# verify that non-hex digests raise an exception
{
    no warnings qw/ once redefine /;
    local *Algorithm::Voting::Sortition::digest = sub { return "zzzz"; };
    local *Algorithm::Voting::Sortition::n      = sub { return 5 };
    my $s = $avs->new(candidates => ['a'..'e']);
    my @seq;
    throws_ok { @seq = $s->seq } qr/invalid hex/, "invalid hex raises exception";
    warn "@seq";
}

t/sortition/10-rfc3797.t  view on Meta::CPAN

# $URL$

use strict;
use warnings;
use Data::Dumper;
use Test::More 'no_plan';

my $avs = 'Algorithm::Voting::Sortition';
use_ok($avs);

# verify that A::V::S generates the same keystring as in
# L<http://tools.ietf.org/html/rfc3797#section-6>
{
    my @source = (
        "9319",
        [ qw/ 2 5 12 8 10 / ],      # <= this one gets sorted
        [ qw/ 9 18 26 34 41 45 /],
    );
    my $ks = q(9319./2.5.8.10.12./9.18.26.34.41.45./);
    is ($avs->make_keystring(@source), $ks);
}

# verify that A::V::S generates checksums identical to
# L<http://tools.ietf.org/html/rfc3797#section-6>
{
    my $ks = q(9319./2.5.8.10.12./9.18.26.34.41.45./);
    my $box = Algorithm::Voting::Sortition->new(candidates => [], n => 10, keystring => $ks);
    is($box->n, 10);
    is($box->keystring, $ks);

    # the first string is the digest of the keystring bracketed by the string
    # "\x00\x00", the next "\x00\x01", and so on.