uvcount.pl

   1 #!/usr/bin/perl -w
   2
   3 ###############################################################################
   4 # UseVoteGer 4.12 Stimmauswertung
   5 # (c) 2001-2014 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 }