1 | use strict; |
---|
2 | use warnings; |
---|
3 | use Test::More; |
---|
4 | |
---|
5 | # $Id$ |
---|
6 | |
---|
7 | # Tpoll Structure: |
---|
8 | # { |
---|
9 | # poll => { var => $val }, |
---|
10 | # choices => [ qw() ], |
---|
11 | # voting => [ qw(mail) ], |
---|
12 | # ballot => { |
---|
13 | # # signing from voting list |
---|
14 | # signing => { sbal => [], fsbal => [] } # list of items |
---|
15 | # }, |
---|
16 | # map => { from => to }, |
---|
17 | # results => { var => $val }, # wanted results |
---|
18 | # } |
---|
19 | my $test_polls = [ |
---|
20 | { # an empty poll |
---|
21 | poll => { label => 'empty poll' }, |
---|
22 | choices => [ qw(ch1 ch2) ], |
---|
23 | test_count => 4, |
---|
24 | tests => sub { |
---|
25 | my ($r) = @_; |
---|
26 | is($r->absolute_majority, 1, "Can get absolute_majority"); |
---|
27 | is($r->ballots_count, 0, "can get ballot count"); |
---|
28 | is($r->voting_count, 0, "can get voting count"); |
---|
29 | is($r->signing_count, 0, "can get signing count"); |
---|
30 | } |
---|
31 | }, |
---|
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"); |
---|
46 | is($r->ballots_count, 4, "can get ballot count"); |
---|
47 | is($r->_voices_ballot_count, 3, "can get ballot count"); |
---|
48 | is($r->voting_count, 6, "can get voting count"); |
---|
49 | is($r->signing_count, 4, "can get signing count"); |
---|
50 | my $res = $r->results; |
---|
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' ] }, |
---|
62 | d => { sbal => [ 'ch1', 'ch2', 'ch4' ] }, |
---|
63 | f => {}, |
---|
64 | }, |
---|
65 | map_values => sub { |
---|
66 | my ($r) = @_; |
---|
67 | $r->map_value('ch10', 'ch1'); |
---|
68 | }, |
---|
69 | test_count => 14, |
---|
70 | tests => sub { |
---|
71 | my ($r) = @_; |
---|
72 | is($r->absolute_majority, 2, "Can get absolute_majority"); |
---|
73 | is($r->ballots_count, 4, "can get ballot count"); |
---|
74 | is($r->not_empty_ballot_count, 3, "can get ballot count"); |
---|
75 | is($r->empty_ballot_count, 1, "can get empty ballot count"); |
---|
76 | is($r->voting_count, 6, "can get voting count"); |
---|
77 | is($r->signing_count, 4, "can get signing count"); |
---|
78 | my $res = $r->results; |
---|
79 | is($res->[0]->{value}, 'ch1', "winner is ch1"); |
---|
80 | is($res->[0]->{count}, 3, "winner has 3 voices"); |
---|
81 | ok($res->[0]->{abs_maj}, "winner has absolute majority"); |
---|
82 | ok($res->[0]->{elected}, "winner is set as elected"); |
---|
83 | is(@$res, 4, "count of winners"); |
---|
84 | is($res->[3]->{count}, 0, "last has 0 voices"); |
---|
85 | ok(!$res->[3]->{abs_maj}, "last has not absolute majority"); |
---|
86 | ok(!$res->[3]->{elected}, "last is not set as elected"); |
---|
87 | } |
---|
88 | }, |
---|
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"); |
---|
107 | is($r->ballots_count, 5, "can get ballot count"); |
---|
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 | }, |
---|
119 | ]; |
---|
120 | |
---|
121 | my $poll_test_count = 0; |
---|
122 | $poll_test_count += ($_->{test_count} || 0) foreach(@$test_polls); |
---|
123 | |
---|
124 | plan tests => |
---|
125 | 3 # Fixed test |
---|
126 | + scalar(@$test_polls) * 8 # number of tested polls scenario |
---|
127 | + $poll_test_count; # poll test |
---|
128 | |
---|
129 | use_ok 'Epoll', 'Epoll'; |
---|
130 | use_ok 'Epoll::DB'; |
---|
131 | $ENV{EPOLL_NO_COMMIT} = 1; |
---|
132 | isa_ok(my $vote = Epoll::DB->new(Epoll->config->{db}), 'Epoll::DB'); |
---|
133 | |
---|
134 | my $count = 0; |
---|
135 | foreach my $tpoll (@$test_polls) { |
---|
136 | $count++; |
---|
137 | diag("Testing vote #$count: " . ($tpoll->{poll}{label} || 'No name')); |
---|
138 | ok(my $pollid = $vote->_create_poll('test@', "Vote test $count", "password"), |
---|
139 | "can create a new poll"); |
---|
140 | |
---|
141 | isa_ok(my $poll = $vote->poll($pollid), 'Epoll::DB::Poll'); |
---|
142 | |
---|
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 | |
---|
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( |
---|
162 | $name, $tpoll->{ballot}{$name}{sbal}, 'localhost' |
---|
163 | ); |
---|
164 | } |
---|
165 | |
---|
166 | if ($tpoll->{map_values}) { |
---|
167 | $tpoll->{map_values}->($poll); |
---|
168 | } |
---|
169 | |
---|
170 | isa_ok(my $results = $vote->results($pollid), 'Epoll::DB::Poll'); |
---|
171 | |
---|
172 | ok($results->decrypted_ballots(), "Can decrypt ballot"); |
---|
173 | ok($results->compute_results(), "Can compute results"); |
---|
174 | |
---|
175 | $tpoll->{tests}->($results); |
---|
176 | |
---|
177 | $vote->db->rollback; # really rollback |
---|
178 | } |
---|
179 | |
---|