Drop commonly used accounts from mailpatterns.
[usenet/usevote.git] / uvcount.pl
1 #!/usr/bin/perl -w
2
3 ###############################################################################
4 # UseVoteGer 4.09 Stimmauswertung
5 # (c) 2001-2005 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 }
This page took 0.021905 seconds and 3 git commands to generate.