| 1 | #!/usr/bin/perl -w |
| 2 | |
| 3 | ############################################################################### |
| 4 | # UseVoteGer 4.11 Stimmauswertung |
| 5 | # (c) 2001-2012 Marc Langer <uv@marclanger.de> |
| 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 | } |