Commit | Line | Data |
---|---|---|
ac7e2c54 TH |
1 | #!/usr/bin/perl -w |
2 | ||
3 | ############################################################################### | |
1135267f TH |
4 | # UseVoteGer 4.12 Stimmauswertung |
5 | # (c) 2001-2014 Marc Langer <uv@marclanger.de> | |
ac7e2c54 TH |
6 | # |
7 | # This script package is free software; you can redistribute it and/or | |
8 | # modify it under the terms of the GNU Public License as published by the | |
9 | # Free Software Foundation. | |
10 | # | |
11 | # Use this script to create voter lists and results. | |
12 | # | |
13 | # Many thanks to: | |
14 | # - Ron Dippold (Usevote 3.0, 1993/94) | |
15 | # - Frederik Ramm (German translation, 1994) | |
16 | # - Wolfgang Behrens (UseVoteGer 3.1, based on Frederik's translation, 1998/99) | |
17 | # - Cornell Binder for some good advice and code fragments | |
18 | # | |
19 | # This is a complete rewrite of UseVoteGer 3.1 in Perl (former versions were | |
20 | # written in C). Not all functions of Usevote/UseVoteGer 3.x are implemented! | |
21 | ############################################################################### | |
22 | ||
23 | use strict; | |
24 | use Getopt::Long; | |
25 | use Digest::MD5 qw(md5_hex); | |
26 | use Date::Parse; | |
27 | use FindBin qw($Bin); | |
28 | use lib $Bin; | |
29 | use UVconfig; | |
30 | use UVmenu; | |
31 | use UVmessage; | |
32 | use UVtemplate; | |
33 | ||
34 | my %opt_ctl = (); | |
35 | ||
36 | print STDERR "\n$usevote_version Stimmauswertung - (c) 2001-2005 Marc Langer\n\n"; | |
37 | ||
38 | # unrecognized parameters remain in @ARGV (for "help") | |
39 | Getopt::Long::Configure(qw(pass_through bundling)); | |
40 | ||
41 | # recognized parameters are written into %opt_ctl | |
42 | GetOptions(\%opt_ctl, qw(l|list v|voters r|result n|nodup m|multigroup o|onegroup c|config-file=s f|result-file=s)); | |
43 | ||
44 | if (!$opt_ctl{r} && ($opt_ctl{m} || $opt_ctl{o})) { | |
45 | print STDERR "Die Optionen -m bzw. -o koennen nur in Verbindung mit -r verwendet werden!\n\n"; | |
46 | help(); # show help and exit | |
47 | } elsif (@ARGV || !($opt_ctl{l} || $opt_ctl{v} || $opt_ctl{r})) { | |
48 | # additional parameters passed | |
49 | help(); # show help and exit | |
50 | } elsif ($opt_ctl{l} && $opt_ctl{v}) { | |
51 | print STDERR "Die Optionen -l und -v duerfen nicht zusammen verwendet werden!\n\n"; | |
52 | help(); # show help and exit | |
53 | } elsif ($opt_ctl{m} && $opt_ctl{o}) { | |
54 | print STDERR "Die Optionen -m und -o duerfen nicht zusammen verwendet werden!\n\n"; | |
55 | help(); # show help and exit | |
56 | } | |
57 | ||
58 | # get config file name (default: usevote.cfg) and read it | |
59 | my $cfgfile = $opt_ctl{c} || "usevote.cfg"; | |
60 | UVconfig::read_config($cfgfile); | |
61 | ||
62 | # Overwrite result file if started with option -f | |
63 | $config{resultfile} = $opt_ctl{f} if ($opt_ctl{f}); | |
64 | ||
65 | read_resultfile($opt_ctl{n}); | |
66 | ||
67 | exit 0; | |
68 | ||
69 | ||
70 | ############################################################################## | |
71 | # Read result file and (optionally) sort out duplicate votes # | |
72 | # Parameters: 1 if no duplicates should be deleted, else 0 # | |
73 | ############################################################################## | |
74 | ||
75 | sub read_resultfile { | |
76 | my ($nodup) = @_; | |
77 | my $num = 0; | |
78 | my $invalid = ''; | |
79 | my $inv_count = 0; | |
80 | my $validcount = 0; | |
81 | my $vote = {}; | |
82 | my @votes = (); | |
83 | my @deleted = (); | |
84 | my @votecount = (); | |
85 | my %vnames = (); | |
86 | my %vaddr = (); | |
87 | my %lists = (J => '', N => '', E => ''); # for one-group format | |
88 | my $list = ''; # for multiple-group format | |
89 | my %varname = (J => 'yes', N => 'no', E => 'abstain'); | |
90 | ||
91 | # Initialization of the sum array | |
92 | for (my $group=0; $group<@groups; $group++) { | |
93 | $votecount[$group]->{J} = 0; | |
94 | $votecount[$group]->{N} = 0; | |
95 | $votecount[$group]->{E} = 0; | |
96 | } | |
97 | ||
98 | open(FILE, "<$config{resultfile}") | |
99 | or die UVmessage::get("COUNT_ERR_OPEN", (FILE=>$config{resultfile})) . "\n\n"; | |
100 | ||
101 | # Read file | |
102 | while(<FILE>) { | |
103 | chomp; | |
104 | $num++; | |
105 | ||
106 | unless (/^(\w): (.*)$/) { | |
107 | print STDERR UVmessage::get("COUNT_ERR_RESULT", | |
108 | (FILE=>$config{resultfile}, LINE=>$num)) . "\n"; | |
109 | next; | |
110 | } | |
111 | ||
112 | my $field = $1; | |
113 | my $content = $2; | |
114 | $vote->{$field} = $content; | |
115 | ||
116 | # End of a paragraph reached? | |
117 | if ($field eq 'S') { | |
118 | ||
119 | # The array @votes countains references to the hashes | |
120 | push (@votes, $vote); | |
121 | ||
122 | # For sorting and duplicate detection indexes are build from address and name. | |
123 | # These are hashes containing references to an array of index numbers of | |
124 | # the @votes array. | |
125 | # | |
126 | # Example: $vnames{'marc langer'}->[0] = 2 | |
127 | # $vnames{'marc langer'}->[1] = 10 | |
128 | # Meaning: $votes[2] und $votes[10] contain votes of Marc Langer | |
129 | ||
130 | push (@{$vnames{lc($vote->{N})}}, $#votes); | |
131 | ||
132 | # Conversion in lower case, so that words with an upper case first | |
133 | # letter are not at the top after sorting | |
134 | push (@{$vaddr{lc($vote->{A})}}, $#votes); | |
135 | ||
136 | # reset $vote, begin a new vote | |
137 | $vote = {}; | |
138 | } | |
139 | } | |
140 | ||
141 | close(FILE); | |
142 | ||
143 | # delete cancelled votes | |
144 | foreach my $addr (keys %vaddr) { | |
145 | # Run through all votes belonging to a mail address and search for cancellation | |
146 | for (my $n=0; $n<=$#{$vaddr{$addr}}; $n++) { | |
147 | if ($votes[$vaddr{$addr}->[$n]]->{S} =~ /^\*/) { | |
148 | # delete from array | |
149 | push(@deleted, splice(@{$vaddr{$addr}}, 0, $n+1)); | |
150 | $n=-1; | |
151 | } | |
152 | } | |
153 | } | |
154 | ||
155 | # sort out duplicates? | |
156 | unless ($nodup) { | |
157 | ||
158 | # search for duplicate addresses | |
159 | foreach my $addr (keys %vaddr) { | |
160 | ||
161 | # Run through all votes belonging to a mail address. | |
162 | # If one vote is deleted it has also to be deleted from the array | |
163 | # so that the following addresses move up. In the other case the | |
164 | # counter is incremented as long as further votes are to be compared. | |
165 | ||
166 | my $n=0; | |
167 | while ($n<$#{$vaddr{$addr}}) { | |
168 | ||
169 | my $ask = 0; | |
170 | ||
171 | if ($votes[$vaddr{$addr}->[$n]]->{S} =~ /!/ || | |
172 | $votes[$vaddr{$addr}->[$n+1]]->{S} =~ /!/) { | |
173 | ||
174 | # One of the votes is invalid: Ask votetaker | |
175 | $ask = 1; | |
176 | ||
177 | } else { | |
178 | ||
179 | # Convert date into unixtime (str2time is located in Date::Parse) | |
180 | my $date1 = str2time($votes[$vaddr{$addr}->[$n]]->{D}); | |
181 | my $date2 = str2time($votes[$vaddr{$addr}->[$n+1]]->{D}); | |
182 | ||
183 | # compare dates | |
184 | my $order = $date1 <=> $date2; | |
185 | ||
186 | # first date is earlier | |
187 | if ($order == -1) { | |
188 | push(@deleted, $vaddr{$addr}->[$n]); | |
189 | # delete first element from the array | |
190 | splice(@{$vaddr{$addr}}, $n, 1); | |
191 | ||
192 | # second date is earlier | |
193 | } elsif ($order == 1) { | |
194 | push(@deleted, $vaddr{$addr}->[$n+1]); | |
195 | # delete second element from the array | |
196 | splice(@{$vaddr{$addr}}, $n+1, 1); | |
197 | ||
198 | # both are equal (ask votetaker) | |
199 | } else { | |
200 | $ask = 1; | |
201 | } | |
202 | ||
203 | } | |
204 | ||
205 | # Has votetaker to be asked? | |
206 | if ($ask) { | |
207 | my $default = 0; | |
208 | my $res = UVmenu::dup_choice($votes[$vaddr{$addr}->[0]], | |
209 | $votes[$vaddr{$addr}->[1]], | |
210 | $default); | |
211 | ||
212 | if ($res == 1) { | |
213 | push(@deleted, $vaddr{$addr}->[0]); | |
214 | # delete first element from the array | |
215 | splice(@{$vaddr{$addr}}, $n, 1); | |
216 | ||
217 | } elsif ($res == 2) { | |
218 | push(@deleted, $vaddr{$addr}->[1]); | |
219 | # delete second element from the array | |
220 | splice(@{$vaddr{$addr}}, $n+1, 1); | |
221 | ||
222 | } else { | |
223 | # don't delete anything: increment counter | |
224 | $n++; | |
225 | } | |
226 | } | |
227 | } | |
228 | } | |
229 | ||
230 | # the same for equal names: | |
231 | foreach my $name (keys %vnames) { | |
232 | my $n = 0; | |
233 | while ($n<$#{$vnames{$name}}) { | |
234 | ||
235 | # check if vote was already deleted by prior address sorting | |
236 | if (grep(/^$vnames{$name}->[$n]$/, @deleted)) { | |
237 | # delete first element from the array | |
238 | splice(@{$vnames{$name}}, $n, 1); | |
239 | next; | |
240 | ||
241 | } elsif (grep(/^$vnames{$name}->[$n+1]$/, @deleted)) { | |
242 | # delete second element from the array | |
243 | splice(@{$vnames{$name}}, $n+1, 1); | |
244 | next; | |
245 | } | |
246 | ||
247 | # Convert date into unixtime (str2time is located in Date::Parse) | |
248 | my $date1 = str2time($votes[$vnames{$name}->[$n]]->{D}); | |
249 | my $date2 = str2time($votes[$vnames{$name}->[$n+1]]->{D}); | |
250 | ||
251 | # Set default for menu choice to the earlier vote | |
252 | my $default = ($date2 < $date1) ? 2 : 0; | |
253 | ||
254 | my $res = UVmenu::dup_choice($votes[$vnames{$name}->[$n]], | |
255 | $votes[$vnames{$name}->[$n+1]], | |
256 | $default); | |
257 | ||
258 | # delete first | |
259 | if ($res == 1) { | |
260 | push(@deleted, $vnames{$name}->[$n]); | |
261 | splice(@{$vnames{$name}}, $n, 1); | |
262 | ||
263 | # delete second | |
264 | } elsif ($res == 2) { | |
265 | push(@deleted, $vnames{$name}->[$n+1]); | |
266 | # delete second element from the array | |
267 | splice(@{$vnames{$name}}, $n+1, 1); | |
268 | ||
269 | # don't delete anything: increment counter | |
270 | } else { | |
271 | $n++; | |
272 | } | |
273 | } | |
274 | } | |
275 | ||
276 | print STDERR UVmessage::get("COUNT_DELETED", (NUM=>scalar @deleted)), "\n\n"; | |
277 | } | |
278 | ||
279 | # Count votes and generate voter list | |
280 | ||
281 | my $list_tpl = UVtemplate->new(); | |
282 | $list_tpl->setKey('groupcount' => scalar @groups); | |
283 | ||
284 | # reversed order as caption string for last column comes first | |
285 | for (my $n=$#groups; $n>=0; $n--) { | |
286 | $list_tpl->addListItem('groups', pos=>@groups-$n, group=>$groups[$n]); | |
287 | } | |
288 | ||
289 | # loop through all addresses | |
290 | foreach my $addr (sort keys %vaddr) { | |
291 | ||
292 | # loop through all votes for every address | |
293 | for (my $n=0; $n<@{$vaddr{$addr}}; $n++) { | |
294 | ||
295 | # Ignore vote if already deleted. | |
296 | # If $nodup is not set one single vote should remain | |
297 | unless (grep(/^$vaddr{$addr}->[$n]$/, @deleted)) { | |
298 | ||
299 | # extract $vote for simplier code | |
300 | my $vote = $votes[$vaddr{$addr}->[$n]]; | |
301 | ||
302 | # vote is invalid if there is an exclamation mark | |
303 | if ($vote->{S} =~ /!/) { | |
304 | $inv_count++; | |
305 | } else { | |
306 | # split vote string into single votes and count | |
307 | my @splitvote = split(//, $vote->{S}); | |
308 | if (@groups != @splitvote) { | |
309 | die UVmessage::get("COUNT_ERR_GROUPCOUNT", (ADDR=>$addr, NUM1=>scalar @splitvote, | |
310 | NUM2=>scalar @groups), RESULTFILE=>$config{resultfile}), "\n\n"; | |
311 | } | |
312 | for (my $group=0; $group<@splitvote; $group++) { | |
313 | $votecount[$group]->{$splitvote[$group]}++; | |
314 | } | |
315 | $validcount++; | |
316 | } | |
317 | ||
318 | if ($opt_ctl{l} || $opt_ctl{v}) { | |
319 | ||
320 | # vote is invalid if there is an exclamation mark | |
321 | if ($vote->{S} =~ /!/) { | |
322 | $list_tpl->addListItem('invalid', (name=>$vote->{N}, mail=>$vote->{A}, reason=>$vote->{S})); | |
323 | ||
324 | # in other cases the vote is valid: generate list of votes | |
325 | } else { | |
326 | ||
327 | # one-group or multiple-group format? | |
328 | # must use multiple-group data structure for voter list (2. CfV)! | |
329 | if ($#groups || $opt_ctl{l}) { | |
330 | $list_tpl->addListItem('multi', (name=>$vote->{N}, mail=>$vote->{A}, vote=>$vote->{S})); | |
331 | } else { | |
332 | my ($votestring) = split(//, $vote->{S}); | |
333 | $list_tpl->addListItem($varname{$votestring}, (name=>$vote->{N}, mail=>$vote->{A})); | |
334 | } | |
335 | ||
336 | } | |
337 | } | |
338 | } | |
339 | } | |
340 | } | |
341 | ||
342 | if ($opt_ctl{r}) { | |
343 | ||
344 | my $tplname; | |
345 | my $result_tpl = UVtemplate->new(); | |
346 | $result_tpl->setKey('votename' => $config{votename}); | |
347 | $result_tpl->setKey('numvalid' => $validcount); | |
348 | $result_tpl->setKey ('numinvalid', $inv_count); | |
349 | ||
350 | # proportional vote? | |
351 | if ($config{proportional}) { | |
352 | $tplname = $config{'tpl_result_prop'}; | |
353 | for (my $group=0; $group<@votecount; $group++) { | |
354 | # calculate conditions | |
355 | my $yes = $votecount[$group]->{J}; | |
356 | my $no = $votecount[$group]->{N}; | |
357 | my $cond1 = eval $config{condition1}; | |
358 | my $proportion = 0; | |
359 | ||
360 | # don't evaluate if division by zero | |
361 | unless ($config{prop_formula} =~ m#.+/(.+)# && eval($1)==0) { | |
362 | $proportion = eval $config{prop_formula}; | |
363 | } | |
364 | ||
365 | # generate result line | |
366 | $result_tpl->addListItem('count', (yes => $votecount[$group]->{J}, | |
367 | no => $votecount[$group]->{N}, | |
368 | cond1 => $cond1, | |
369 | proportion => $proportion, | |
370 | result => '', # must be set manually | |
371 | group => $groups[$group])); | |
372 | } | |
373 | ||
374 | } else { | |
375 | # use one-group or multiple-group format? | |
376 | if (@groups == 1 && (!($config{multigroup} || $opt_ctl{m}) || $opt_ctl{o})) { | |
377 | $tplname = $config{'tpl_result_single'}; | |
378 | my $yes = $votecount[0]->{J}; | |
379 | my $no = $votecount[0]->{N}; | |
380 | my $acc1 = eval $config{condition1}; | |
381 | my $acc2 = eval $config{condition2}; | |
382 | $result_tpl->setKey('yes' => $votecount[0]->{J}); | |
383 | $result_tpl->setKey('no' => $votecount[0]->{N}); | |
384 | $result_tpl->setKey('numabstain' => $votecount[0]->{E}); | |
385 | $result_tpl->setKey('cond1' => $acc1); | |
386 | $result_tpl->setKey('cond2' => $acc2); | |
387 | ||
388 | } else { | |
389 | $tplname = $config{'tpl_result_multi'}; | |
390 | $result_tpl->setKey('numabstain' => 0); | |
391 | ||
392 | for (my $group=0; $group<@votecount; $group++) { | |
393 | # calculate conditions | |
394 | my $yes = $votecount[$group]->{J}; | |
395 | my $no = $votecount[$group]->{N}; | |
396 | my $cond1 = eval $config{condition1}; | |
397 | my $cond2 = eval $config{condition2}; | |
398 | ||
399 | # generate result line | |
400 | $result_tpl->addListItem('count', (yes => $votecount[$group]->{J}, | |
401 | no => $votecount[$group]->{N}, | |
402 | cond1 => $cond1, | |
403 | cond2 => $cond2, | |
404 | result => ($cond1 && $cond2), | |
405 | group => $groups[$group])); | |
406 | ||
407 | } | |
408 | } | |
409 | ||
410 | $result_tpl->setKey ('numabstain', $votecount[0]->{E}) if (@votecount == 1); | |
411 | } | |
412 | ||
413 | print $result_tpl->processTemplate($tplname); | |
414 | ||
415 | } | |
416 | ||
417 | if ($opt_ctl{v}) { | |
418 | ||
419 | # one-group or multiple-group format? | |
420 | if ($#groups) { | |
421 | print $list_tpl->processTemplate($config{'tpl_votes_multi'}); | |
422 | } else { | |
423 | print $list_tpl->processTemplate($config{'tpl_votes_single'}); | |
424 | } | |
425 | ||
426 | } elsif ($opt_ctl{l}) { | |
427 | print $list_tpl->processTemplate($config{'tpl_voterlist'}); | |
428 | } | |
429 | ||
430 | } | |
431 | ||
432 | ||
433 | ############################################################################## | |
434 | # Print help text (options and syntax) on -h or --help # | |
435 | ############################################################################## | |
436 | ||
437 | sub help { | |
438 | print STDERR <<EOF; | |
439 | Usage: uvcount.pl [-c config_file] [-f result_file] [-l | -v] [-r [-m | -o]] [-n] | |
440 | uvcount.pl -h | |
441 | ||
442 | Zaehlt Stimmen und gibt Waehlerlisten aus. | |
443 | ||
444 | -c config_file liest die Konfiguration aus config_file | |
445 | (usevote.cfg falls nicht angegeben) | |
446 | ||
447 | -f result_file liest die Stimmen aus result_file (ueberschreibt | |
448 | die "resultfile"-Angabe aus der Konfigurationsdatei) | |
449 | ||
450 | -l, --list Gibt eine Liste aller Waehler aus (ohne Stimmen). | |
451 | ||
452 | -v, --voters Wie -l, aber mit Angabe der abgegebenen Stimmen. | |
453 | ||
454 | -r, --result Ausgabe des Endergebnisses (kann mit -l oder -v | |
455 | kombiniert werden). | |
456 | ||
457 | -m, --multigroup Benutzt auch bei Eingruppenabstimmungen das | |
458 | Mehrgruppenformat beim Endergebnis (ueberschreibt | |
459 | die Einstellung aus usevote.cfg). | |
460 | Nur in Kombination mit -r verwendbar, schliesst -o aus. | |
461 | ||
462 | -o, --onegroup Benutzt bei Eingruppenabstimmungen immer das | |
463 | Eingruppenformat beim Endergebnis (ueberschreibt | |
464 | die Einstellung aus usevote.cfg). | |
465 | Nur in Kombination mit -r verwendbar, schliesst -m aus. | |
466 | ||
467 | -n, --nodup Verzichtet auf das Aussortieren von doppelten | |
468 | Stimmabgaben. Nicht empfohlen! | |
469 | ||
470 | -h, --help zeigt diesen Hilfetext an | |
471 | ||
472 | EOF | |
473 | ||
474 | exit 0; | |
475 | } |