use strict; use warnings; use Test::More; # $Id$ # Tpoll Structure: # { # poll => { var => $val }, # choices => [ qw() ], # voting => [ qw(mail) ], # ballot => { # # signing from voting list # signing => { sbal => [], fsbal => [] } # list of items # }, # map => { from => to }, # results => { var => $val }, # wanted results # } my $test_polls = [ { # an empty poll poll => { label => 'empty poll' }, choices => [ qw(ch1 ch2) ], test_count => 4, tests => sub { my ($r) = @_; is($r->absolute_majority, 1, "Can get absolute_majority"); is($r->ballots_count, 0, "can get ballot count"); is($r->voting_count, 0, "can get voting count"); is($r->signing_count, 0, "can get signing count"); } }, { poll => { label => 'some vals' }, choices => [ qw(ch1 ch2) ], voting => [ qw(a b c d e f) ], ballot => { a => { sbal => [ 'ch1' ] }, b => { sbal => [ 'ch1', 'ch10' ] }, d => { sbal => [ 'ch1', 'ch2' ] }, f => {}, }, test_count => 7, tests => sub { my ($r) = @_; is($r->absolute_majority, 2, "Can get absolute_majority"); is($r->ballots_count, 4, "can get ballot count"); is($r->_voices_ballot_count, 3, "can get ballot count"); is($r->voting_count, 6, "can get voting count"); is($r->signing_count, 4, "can get signing count"); my $res = $r->results; is($res->[0]->{value}, 'ch1', "winner is ch1"); is($res->[0]->{count}, 3, "winner has 3 voices"); } }, { poll => { label => 'some vals with mapped values' }, choices => [ qw(ch1 ch2 ch3) ], voting => [ qw(a b c d e f) ], ballot => { a => { sbal => [ 'ch1' ] }, b => { sbal => [ 'ch1', 'ch10' ] }, d => { sbal => [ 'ch1', 'ch2', 'ch4' ] }, f => {}, }, map_values => sub { my ($r) = @_; $r->map_value('ch10', 'ch1'); }, test_count => 14, tests => sub { my ($r) = @_; is($r->absolute_majority, 2, "Can get absolute_majority"); is($r->ballots_count, 4, "can get ballot count"); is($r->not_empty_ballot_count, 3, "can get ballot count"); is($r->empty_ballot_count, 1, "can get empty ballot count"); is($r->voting_count, 6, "can get voting count"); is($r->signing_count, 4, "can get signing count"); my $res = $r->results; is($res->[0]->{value}, 'ch1', "winner is ch1"); is($res->[0]->{count}, 3, "winner has 3 voices"); ok($res->[0]->{abs_maj}, "winner has absolute majority"); ok($res->[0]->{elected}, "winner is set as elected"); is(@$res, 4, "count of winners"); is($res->[3]->{count}, 0, "last has 0 voices"); ok(!$res->[3]->{abs_maj}, "last has not absolute majority"); ok(!$res->[3]->{elected}, "last is not set as elected"); } }, { poll => { label => 'empty ballot count', empty_ballot_has_voice => 1, }, choices => [ qw(ch1 ch2 ch3) ], voting => [ qw(a b c d e f) ], ballot => { a => { sbal => [ 'ch1' ] }, b => { sbal => [ 'ch1', 'ch2' ] }, d => { sbal => [ 'ch1', 'ch2' ] }, e => {}, f => {}, }, test_count => 10, tests => sub { my ($r) = @_; is($r->absolute_majority, 3, "Can get absolute_majority"); is($r->ballots_count, 5, "can get ballot count"); is($r->not_empty_ballot_count, 3, "can get ballot count"); is($r->empty_ballot_count, 2, "can get empty ballot count"); is($r->voting_count, 6, "can get voting count"); is($r->signing_count, 5, "can get signing count"); my $res = $r->results; is($res->[0]->{value}, 'ch1', "winner is ch1"); is($res->[0]->{count}, 3, "winner has 3 voices"); is(@$res, 4, "count of winners"); is($res->[3]->{count}, 0, "last has 0 voices"); } }, ]; my $poll_test_count = 0; $poll_test_count += ($_->{test_count} || 0) foreach(@$test_polls); plan tests => 3 # Fixed test + scalar(@$test_polls) * 8 # number of tested polls scenario + $poll_test_count; # poll test use_ok 'Epoll', 'Epoll'; use_ok 'Epoll::DB'; $ENV{EPOLL_NO_COMMIT} = 1; isa_ok(my $vote = Epoll::DB->new(Epoll->config->{db}), 'Epoll::DB'); my $count = 0; foreach my $tpoll (@$test_polls) { $count++; diag("Testing vote #$count: " . ($tpoll->{poll}{label} || 'No name')); ok(my $pollid = $vote->_create_poll('test@', "Vote test $count", "password"), "can create a new poll"); isa_ok(my $poll = $vote->poll($pollid), 'Epoll::DB::Poll'); ok(my $puid = $poll->uid, "can get poll uid"); is($vote->poll_id_from_uid($puid), $pollid, "can get id from uid"); foreach (keys %{ $tpoll->{poll} || {}}) { $poll->param($_ => $tpoll->{poll}{$_}); } $poll->addupd_voting($_) foreach (@{ $tpoll->{voting} || [] }); foreach (@{ $tpoll->{choices} || [] }) { $poll->add_choice($_); } ok(eq_set( [ map { $poll->choice($_)->info->{label} } $poll->choices ], $tpoll->{choices} || []), "choices were added"); foreach my $name (keys %{ $tpoll->{ballot} || {} }) { $poll->register_ballot( $name, $tpoll->{ballot}{$name}{sbal}, 'localhost' ); } if ($tpoll->{map_values}) { $tpoll->{map_values}->($poll); } isa_ok(my $results = $vote->results($pollid), 'Epoll::DB::Poll'); ok($results->decrypted_ballots(), "Can decrypt ballot"); ok($results->compute_results(), "Can compute results"); $tpoll->{tests}->($results); $vote->db->rollback; # really rollback }