[201] | 1 | use strict; |
---|
| 2 | use warnings; |
---|
| 3 | use Test::More; |
---|
| 4 | |
---|
| 5 | # $Id$ |
---|
| 6 | |
---|
[213] | 7 | # Tpoll Structure: |
---|
[201] | 8 | # { |
---|
[202] | 9 | # poll => { var => $val }, |
---|
| 10 | # choices => [ qw() ], |
---|
[201] | 11 | # voting => [ qw(mail) ], |
---|
| 12 | # ballot => { |
---|
| 13 | # # signing from voting list |
---|
[202] | 14 | # signing => { sbal => [], fsbal => [] } # list of items |
---|
[201] | 15 | # }, |
---|
[202] | 16 | # map => { from => to }, |
---|
| 17 | # results => { var => $val }, # wanted results |
---|
[201] | 18 | # } |
---|
[213] | 19 | my $test_polls = [ |
---|
[202] | 20 | { # an empty poll |
---|
| 21 | poll => { label => 'empty poll' }, |
---|
| 22 | choices => [ qw(ch1 ch2) ], |
---|
[213] | 23 | test_count => 4, |
---|
| 24 | tests => sub { |
---|
| 25 | my ($r) = @_; |
---|
| 26 | is($r->absolute_majority, 1, "Can get absolute_majority"); |
---|
[319] | 27 | is($r->ballots_count, 0, "can get ballot count"); |
---|
[213] | 28 | is($r->voting_count, 0, "can get voting count"); |
---|
| 29 | is($r->signing_count, 0, "can get signing count"); |
---|
[202] | 30 | } |
---|
| 31 | }, |
---|
[213] | 32 | { |
---|
| 33 | poll => { label => 'some vals' }, |
---|
| 34 | choices => [ qw(ch1 ch2) ], |
---|
| 35 | voting => [ qw(a b c d e f) ], |
---|
| 36 | ballot => { |
---|
| 37 | a => { sbal => [ 'ch1' ] }, |
---|
| 38 | b => { sbal => [ 'ch1', 'ch10' ] }, |
---|
| 39 | d => { sbal => [ 'ch1', 'ch2' ] }, |
---|
| 40 | f => {}, |
---|
| 41 | }, |
---|
| 42 | test_count => 7, |
---|
| 43 | tests => sub { |
---|
| 44 | my ($r) = @_; |
---|
| 45 | is($r->absolute_majority, 2, "Can get absolute_majority"); |
---|
[319] | 46 | is($r->ballots_count, 4, "can get ballot count"); |
---|
| 47 | is($r->_voices_ballot_count, 3, "can get ballot count"); |
---|
[213] | 48 | is($r->voting_count, 6, "can get voting count"); |
---|
| 49 | is($r->signing_count, 4, "can get signing count"); |
---|
[216] | 50 | my $res = $r->results; |
---|
[213] | 51 | is($res->[0]->{value}, 'ch1', "winner is ch1"); |
---|
| 52 | is($res->[0]->{count}, 3, "winner has 3 voices"); |
---|
| 53 | } |
---|
| 54 | }, |
---|
| 55 | { |
---|
| 56 | poll => { label => 'some vals with mapped values' }, |
---|
| 57 | choices => [ qw(ch1 ch2 ch3) ], |
---|
| 58 | voting => [ qw(a b c d e f) ], |
---|
| 59 | ballot => { |
---|
| 60 | a => { sbal => [ 'ch1' ] }, |
---|
| 61 | b => { sbal => [ 'ch1', 'ch10' ] }, |
---|
[214] | 62 | d => { sbal => [ 'ch1', 'ch2', 'ch4' ] }, |
---|
[213] | 63 | f => {}, |
---|
| 64 | }, |
---|
[319] | 65 | map_values => sub { |
---|
| 66 | my ($r) = @_; |
---|
| 67 | $r->map_value('ch10', 'ch1'); |
---|
| 68 | }, |
---|
[216] | 69 | test_count => 14, |
---|
[213] | 70 | tests => sub { |
---|
| 71 | my ($r) = @_; |
---|
| 72 | is($r->absolute_majority, 2, "Can get absolute_majority"); |
---|
[319] | 73 | is($r->ballots_count, 4, "can get ballot count"); |
---|
[214] | 74 | is($r->not_empty_ballot_count, 3, "can get ballot count"); |
---|
| 75 | is($r->empty_ballot_count, 1, "can get empty ballot count"); |
---|
[213] | 76 | is($r->voting_count, 6, "can get voting count"); |
---|
| 77 | is($r->signing_count, 4, "can get signing count"); |
---|
[214] | 78 | my $res = $r->results; |
---|
[213] | 79 | is($res->[0]->{value}, 'ch1', "winner is ch1"); |
---|
| 80 | is($res->[0]->{count}, 3, "winner has 3 voices"); |
---|
[216] | 81 | ok($res->[0]->{abs_maj}, "winner has absolute majority"); |
---|
| 82 | ok($res->[0]->{elected}, "winner is set as elected"); |
---|
[214] | 83 | is(@$res, 4, "count of winners"); |
---|
| 84 | is($res->[3]->{count}, 0, "last has 0 voices"); |
---|
[216] | 85 | ok(!$res->[3]->{abs_maj}, "last has not absolute majority"); |
---|
| 86 | ok(!$res->[3]->{elected}, "last is not set as elected"); |
---|
[213] | 87 | } |
---|
| 88 | }, |
---|
[214] | 89 | { |
---|
| 90 | poll => { |
---|
| 91 | label => 'empty ballot count', |
---|
| 92 | empty_ballot_has_voice => 1, |
---|
| 93 | }, |
---|
| 94 | choices => [ qw(ch1 ch2 ch3) ], |
---|
| 95 | voting => [ qw(a b c d e f) ], |
---|
| 96 | ballot => { |
---|
| 97 | a => { sbal => [ 'ch1' ] }, |
---|
| 98 | b => { sbal => [ 'ch1', 'ch2' ] }, |
---|
| 99 | d => { sbal => [ 'ch1', 'ch2' ] }, |
---|
| 100 | e => {}, |
---|
| 101 | f => {}, |
---|
| 102 | }, |
---|
| 103 | test_count => 10, |
---|
| 104 | tests => sub { |
---|
| 105 | my ($r) = @_; |
---|
| 106 | is($r->absolute_majority, 3, "Can get absolute_majority"); |
---|
[319] | 107 | is($r->ballots_count, 5, "can get ballot count"); |
---|
[214] | 108 | is($r->not_empty_ballot_count, 3, "can get ballot count"); |
---|
| 109 | is($r->empty_ballot_count, 2, "can get empty ballot count"); |
---|
| 110 | is($r->voting_count, 6, "can get voting count"); |
---|
| 111 | is($r->signing_count, 5, "can get signing count"); |
---|
| 112 | my $res = $r->results; |
---|
| 113 | is($res->[0]->{value}, 'ch1', "winner is ch1"); |
---|
| 114 | is($res->[0]->{count}, 3, "winner has 3 voices"); |
---|
| 115 | is(@$res, 4, "count of winners"); |
---|
| 116 | is($res->[3]->{count}, 0, "last has 0 voices"); |
---|
| 117 | } |
---|
| 118 | }, |
---|
[201] | 119 | ]; |
---|
| 120 | |
---|
[213] | 121 | my $poll_test_count = 0; |
---|
| 122 | $poll_test_count += ($_->{test_count} || 0) foreach(@$test_polls); |
---|
| 123 | |
---|
[201] | 124 | plan tests => |
---|
[213] | 125 | 3 # Fixed test |
---|
[319] | 126 | + scalar(@$test_polls) * 8 # number of tested polls scenario |
---|
| 127 | + $poll_test_count; # poll test |
---|
[201] | 128 | |
---|
[242] | 129 | use_ok 'Epoll', 'Epoll'; |
---|
| 130 | use_ok 'Epoll::DB'; |
---|
[201] | 131 | $ENV{EPOLL_NO_COMMIT} = 1; |
---|
[242] | 132 | isa_ok(my $vote = Epoll::DB->new(Epoll->config->{db}), 'Epoll::DB'); |
---|
[201] | 133 | |
---|
| 134 | my $count = 0; |
---|
| 135 | foreach my $tpoll (@$test_polls) { |
---|
| 136 | $count++; |
---|
[202] | 137 | diag("Testing vote #$count: " . ($tpoll->{poll}{label} || 'No name')); |
---|
[309] | 138 | ok(my $pollid = $vote->_create_poll('test@', "Vote test $count", "password"), |
---|
[201] | 139 | "can create a new poll"); |
---|
| 140 | |
---|
[242] | 141 | isa_ok(my $poll = $vote->poll($pollid), 'Epoll::DB::Poll'); |
---|
[202] | 142 | |
---|
[225] | 143 | ok(my $puid = $poll->uid, "can get poll uid"); |
---|
| 144 | is($vote->poll_id_from_uid($puid), $pollid, "can get id from uid"); |
---|
| 145 | |
---|
[202] | 146 | foreach (keys %{ $tpoll->{poll} || {}}) { |
---|
| 147 | $poll->param($_ => $tpoll->{poll}{$_}); |
---|
| 148 | } |
---|
| 149 | |
---|
| 150 | $poll->addupd_voting($_) foreach (@{ $tpoll->{voting} || [] }); |
---|
| 151 | |
---|
| 152 | foreach (@{ $tpoll->{choices} || [] }) { |
---|
| 153 | $poll->add_choice($_); |
---|
| 154 | } |
---|
| 155 | |
---|
| 156 | ok(eq_set( |
---|
| 157 | [ map { $poll->choice($_)->info->{label} } $poll->choices ], |
---|
| 158 | $tpoll->{choices} || []), "choices were added"); |
---|
| 159 | |
---|
| 160 | foreach my $name (keys %{ $tpoll->{ballot} || {} }) { |
---|
| 161 | $poll->register_ballot( |
---|
[219] | 162 | $name, $tpoll->{ballot}{$name}{sbal}, 'localhost' |
---|
[202] | 163 | ); |
---|
| 164 | } |
---|
[319] | 165 | |
---|
| 166 | if ($tpoll->{map_values}) { |
---|
| 167 | $tpoll->{map_values}->($poll); |
---|
| 168 | } |
---|
[202] | 169 | |
---|
[242] | 170 | isa_ok(my $results = $vote->results($pollid), 'Epoll::DB::Poll'); |
---|
[202] | 171 | |
---|
[319] | 172 | ok($results->decrypted_ballots(), "Can decrypt ballot"); |
---|
| 173 | ok($results->compute_results(), "Can compute results"); |
---|
[202] | 174 | |
---|
[269] | 175 | $tpoll->{tests}->($results); |
---|
| 176 | |
---|
[213] | 177 | $vote->db->rollback; # really rollback |
---|
| 178 | } |
---|
[202] | 179 | |
---|