3 ###############################################################################
4 # UseVoteGer 4.12 Stimmauswertung
5 # (c) 2001-2014 Marc Langer <uv@marclanger.de>
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.
11 # Use this script to create voter lists and results.
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
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 ###############################################################################
25 use Digest::MD5 qw(md5_hex);
36 print STDERR "\n$usevote_version Stimmauswertung - (c) 2001-2005 Marc Langer\n\n";
38 # unrecognized parameters remain in @ARGV (for "help")
39 Getopt::Long::Configure(qw(pass_through bundling));
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));
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
58 # get config file name (default: usevote.cfg) and read it
59 my $cfgfile = $opt_ctl{c} || "usevote.cfg";
60 UVconfig::read_config($cfgfile);
62 # Overwrite result file if started with option -f
63 $config{resultfile} = $opt_ctl{f} if ($opt_ctl{f});
65 read_resultfile($opt_ctl{n});
70 ##############################################################################
71 # Read result file and (optionally) sort out duplicate votes #
72 # Parameters: 1 if no duplicates should be deleted, else 0 #
73 ##############################################################################
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');
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;
98 open(FILE, "<$config{resultfile}")
99 or die UVmessage::get("COUNT_ERR_OPEN", (FILE=>$config{resultfile})) . "\n\n";
106 unless (/^(\w): (.*)$/) {
107 print STDERR UVmessage::get("COUNT_ERR_RESULT",
108 (FILE=>$config{resultfile}, LINE=>$num)) . "\n";
114 $vote->{$field} = $content;
116 # End of a paragraph reached?
119 # The array @votes countains references to the hashes
120 push (@votes, $vote);
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
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
130 push (@{$vnames{lc($vote->{N})}}, $#votes);
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);
136 # reset $vote, begin a new vote
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} =~ /^\*/) {
149 push(@deleted, splice(@{$vaddr{$addr}}, 0, $n+1));
155 # sort out duplicates?
158 # search for duplicate addresses
159 foreach my $addr (keys %vaddr) {
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.
167 while ($n<$#{$vaddr{$addr}}) {
171 if ($votes[$vaddr{$addr}->[$n]]->{S} =~ /!/ ||
172 $votes[$vaddr{$addr}->[$n+1]]->{S} =~ /!/) {
174 # One of the votes is invalid: Ask votetaker
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});
184 my $order = $date1 <=> $date2;
186 # first date is earlier
188 push(@deleted, $vaddr{$addr}->[$n]);
189 # delete first element from the array
190 splice(@{$vaddr{$addr}}, $n, 1);
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);
198 # both are equal (ask votetaker)
205 # Has votetaker to be asked?
208 my $res = UVmenu::dup_choice($votes[$vaddr{$addr}->[0]],
209 $votes[$vaddr{$addr}->[1]],
213 push(@deleted, $vaddr{$addr}->[0]);
214 # delete first element from the array
215 splice(@{$vaddr{$addr}}, $n, 1);
217 } elsif ($res == 2) {
218 push(@deleted, $vaddr{$addr}->[1]);
219 # delete second element from the array
220 splice(@{$vaddr{$addr}}, $n+1, 1);
223 # don't delete anything: increment counter
230 # the same for equal names:
231 foreach my $name (keys %vnames) {
233 while ($n<$#{$vnames{$name}}) {
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);
241 } elsif (grep(/^$vnames{$name}->[$n+1]$/, @deleted)) {
242 # delete second element from the array
243 splice(@{$vnames{$name}}, $n+1, 1);
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});
251 # Set default for menu choice to the earlier vote
252 my $default = ($date2 < $date1) ? 2 : 0;
254 my $res = UVmenu::dup_choice($votes[$vnames{$name}->[$n]],
255 $votes[$vnames{$name}->[$n+1]],
260 push(@deleted, $vnames{$name}->[$n]);
261 splice(@{$vnames{$name}}, $n, 1);
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);
269 # don't delete anything: increment counter
276 print STDERR UVmessage::get("COUNT_DELETED", (NUM=>scalar @deleted)), "\n\n";
279 # Count votes and generate voter list
281 my $list_tpl = UVtemplate->new();
282 $list_tpl->setKey('groupcount' => scalar @groups);
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]);
289 # loop through all addresses
290 foreach my $addr (sort keys %vaddr) {
292 # loop through all votes for every address
293 for (my $n=0; $n<@{$vaddr{$addr}}; $n++) {
295 # Ignore vote if already deleted.
296 # If $nodup is not set one single vote should remain
297 unless (grep(/^$vaddr{$addr}->[$n]$/, @deleted)) {
299 # extract $vote for simplier code
300 my $vote = $votes[$vaddr{$addr}->[$n]];
302 # vote is invalid if there is an exclamation mark
303 if ($vote->{S} =~ /!/) {
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";
312 for (my $group=0; $group<@splitvote; $group++) {
313 $votecount[$group]->{$splitvote[$group]}++;
318 if ($opt_ctl{l} || $opt_ctl{v}) {
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}));
324 # in other cases the vote is valid: generate list of votes
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}));
332 my ($votestring) = split(//, $vote->{S});
333 $list_tpl->addListItem($varname{$votestring}, (name=>$vote->{N}, mail=>$vote->{A}));
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);
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};
360 # don't evaluate if division by zero
361 unless ($config{prop_formula} =~ m#.+/(.+)# && eval($1)==0) {
362 $proportion = eval $config{prop_formula};
365 # generate result line
366 $result_tpl->addListItem('count', (yes => $votecount[$group]->{J},
367 no => $votecount[$group]->{N},
369 proportion => $proportion,
370 result => '', # must be set manually
371 group => $groups[$group]));
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);
389 $tplname = $config{'tpl_result_multi'};
390 $result_tpl->setKey('numabstain' => 0);
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};
399 # generate result line
400 $result_tpl->addListItem('count', (yes => $votecount[$group]->{J},
401 no => $votecount[$group]->{N},
404 result => ($cond1 && $cond2),
405 group => $groups[$group]));
410 $result_tpl->setKey ('numabstain', $votecount[0]->{E}) if (@votecount == 1);
413 print $result_tpl->processTemplate($tplname);
419 # one-group or multiple-group format?
421 print $list_tpl->processTemplate($config{'tpl_votes_multi'});
423 print $list_tpl->processTemplate($config{'tpl_votes_single'});
426 } elsif ($opt_ctl{l}) {
427 print $list_tpl->processTemplate($config{'tpl_voterlist'});
433 ##############################################################################
434 # Print help text (options and syntax) on -h or --help #
435 ##############################################################################
439 Usage: uvcount.pl [-c config_file] [-f result_file] [-l | -v] [-r [-m | -o]] [-n]
442 Zaehlt Stimmen und gibt Waehlerlisten aus.
444 -c config_file liest die Konfiguration aus config_file
445 (usevote.cfg falls nicht angegeben)
447 -f result_file liest die Stimmen aus result_file (ueberschreibt
448 die "resultfile"-Angabe aus der Konfigurationsdatei)
450 -l, --list Gibt eine Liste aller Waehler aus (ohne Stimmen).
452 -v, --voters Wie -l, aber mit Angabe der abgegebenen Stimmen.
454 -r, --result Ausgabe des Endergebnisses (kann mit -l oder -v
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.
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.
467 -n, --nodup Verzichtet auf das Aussortieren von doppelten
468 Stimmabgaben. Nicht empfohlen!
470 -h, --help zeigt diesen Hilfetext an