Documentation: Add votename to UVmenu.
[usenet/usevote.git] / uvcount.pl
CommitLineData
ac7e2c54
TH
1#!/usr/bin/perl -w
2
3###############################################################################
0618b624
TH
4# UseVoteGer 4.11 Stimmauswertung
5# (c) 2001-2012 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
23use strict;
24use Getopt::Long;
25use Digest::MD5 qw(md5_hex);
26use Date::Parse;
27use FindBin qw($Bin);
28use lib $Bin;
29use UVconfig;
30use UVmenu;
31use UVmessage;
32use UVtemplate;
33
34my %opt_ctl = ();
35
36print STDERR "\n$usevote_version Stimmauswertung - (c) 2001-2005 Marc Langer\n\n";
37
38# unrecognized parameters remain in @ARGV (for "help")
39Getopt::Long::Configure(qw(pass_through bundling));
40
41# recognized parameters are written into %opt_ctl
42GetOptions(\%opt_ctl, qw(l|list v|voters r|result n|nodup m|multigroup o|onegroup c|config-file=s f|result-file=s));
43
44if (!$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
59my $cfgfile = $opt_ctl{c} || "usevote.cfg";
60UVconfig::read_config($cfgfile);
61
62# Overwrite result file if started with option -f
63$config{resultfile} = $opt_ctl{f} if ($opt_ctl{f});
64
65read_resultfile($opt_ctl{n});
66
67exit 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
75sub 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
437sub help {
438 print STDERR <<EOF;
439Usage: uvcount.pl [-c config_file] [-f result_file] [-l | -v] [-r [-m | -o]] [-n]
440 uvcount.pl -h
441
442Zaehlt 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
472EOF
473
474 exit 0;
475}
This page took 0.029302 seconds and 4 git commands to generate.