[usenet/usevote.git] / uvcount.pl

#!/usr/bin/perl -w

###############################################################################
# UseVoteGer 4.12 Stimmauswertung
# (c) 2001-2014 Marc Langer <uv@marclanger.de>
# 
# This script package is free software; you can redistribute it and/or
# modify it under the terms of the GNU Public License as published by the
# Free Software Foundation.
#
# Use this script to create voter lists and results.
#
# Many thanks to:
# - Ron Dippold (Usevote 3.0, 1993/94)
# - Frederik Ramm (German translation, 1994)
# - Wolfgang Behrens (UseVoteGer 3.1, based on Frederik's translation, 1998/99)
# - Cornell Binder for some good advice and code fragments
#
# This is a complete rewrite of UseVoteGer 3.1 in Perl (former versions were
# written in C). Not all functions of Usevote/UseVoteGer 3.x are implemented!
###############################################################################

use strict;
use Getopt::Long;
use Digest::MD5 qw(md5_hex);
use Date::Parse;
use FindBin qw($Bin);
use lib $Bin;
use UVconfig;
use UVmenu;
use UVmessage;
use UVtemplate;

my %opt_ctl = ();

print STDERR "\n$usevote_version Stimmauswertung - (c) 2001-2005 Marc Langer\n\n";

# unrecognized parameters remain in @ARGV (for "help")
Getopt::Long::Configure(qw(pass_through bundling));

# recognized parameters are written into %opt_ctl
GetOptions(\%opt_ctl, qw(l|list v|voters r|result n|nodup m|multigroup o|onegroup c|config-file=s f|result-file=s));

if (!$opt_ctl{r} && ($opt_ctl{m} || $opt_ctl{o})) {
  print STDERR "Die Optionen -m bzw. -o koennen nur in Verbindung mit -r verwendet werden!\n\n";
  help(); # show help and exit
} elsif (@ARGV || !($opt_ctl{l} || $opt_ctl{v} || $opt_ctl{r})) {
  # additional parameters passed
  help(); # show help and exit
} elsif ($opt_ctl{l} && $opt_ctl{v}) {
  print STDERR "Die Optionen -l und -v duerfen nicht zusammen verwendet werden!\n\n";
  help(); # show help and exit
} elsif ($opt_ctl{m} && $opt_ctl{o}) {
  print STDERR "Die Optionen -m und -o duerfen nicht zusammen verwendet werden!\n\n";
  help(); # show help and exit
}

# get config file name (default: usevote.cfg) and read it
my $cfgfile   = $opt_ctl{c} || "usevote.cfg";
UVconfig::read_config($cfgfile);

# Overwrite result file if started with option -f
$config{resultfile} = $opt_ctl{f} if ($opt_ctl{f});

read_resultfile($opt_ctl{n});

exit 0;


##############################################################################
# Read result file and (optionally) sort out duplicate votes                 #
# Parameters: 1 if no duplicates should be deleted, else 0                   #
##############################################################################

sub read_resultfile {
  my ($nodup) = @_;
  my $num = 0;
  my $invalid = '';
  my $inv_count = 0;
  my $validcount = 0;
  my $vote = {};
  my @votes = ();
  my @deleted = ();
  my @votecount = ();
  my %vnames = ();
  my %vaddr = ();
  my %lists = (J => '', N => '', E => '');     # for one-group format
  my $list = '';                               # for multiple-group format
  my %varname = (J => 'yes', N => 'no', E => 'abstain');

  # Initialization of the sum array
  for (my $group=0; $group<@groups; $group++) {
    $votecount[$group]->{J} = 0;
    $votecount[$group]->{N} = 0;
    $votecount[$group]->{E} = 0;
  }

  open(FILE, "<$config{resultfile}")
    or die UVmessage::get("COUNT_ERR_OPEN", (FILE=>$config{resultfile})) . "\n\n";

  # Read file
  while(<FILE>) {
    chomp;
    $num++;

    unless (/^(\w): (.*)$/) {
      print STDERR UVmessage::get("COUNT_ERR_RESULT",
                                  (FILE=>$config{resultfile}, LINE=>$num)) . "\n";
      next;
    }

    my $field = $1;
    my $content = $2;
    $vote->{$field} = $content;

    # End of a paragraph reached?
    if ($field eq 'S') {

      # The array @votes countains references to the hashes
      push (@votes, $vote);

      # For sorting and duplicate detection indexes are build from address and name.
      # These are hashes containing references to an array of index numbers of
      # the @votes array.
      #
      # Example: $vnames{'marc langer'}->[0] = 2
      #          $vnames{'marc langer'}->[1] = 10
      # Meaning: $votes[2] und $votes[10] contain votes of Marc Langer

      push (@{$vnames{lc($vote->{N})}}, $#votes);

      # Conversion in lower case, so that words with an upper case first
      # letter are not at the top after sorting
      push (@{$vaddr{lc($vote->{A})}}, $#votes);

      # reset $vote, begin a new vote
      $vote = {};
    }
  }    

  close(FILE);

  # delete cancelled votes
  foreach my $addr (keys %vaddr) {
    # Run through all votes belonging to a mail address and search for cancellation
    for (my $n=0; $n<=$#{$vaddr{$addr}}; $n++) {
      if ($votes[$vaddr{$addr}->[$n]]->{S} =~ /^\*/) {
        # delete from array
        push(@deleted, splice(@{$vaddr{$addr}}, 0, $n+1));
        $n=-1;
      }
    }
  }

  # sort out duplicates?
  unless ($nodup) {

    # search for duplicate addresses
    foreach my $addr (keys %vaddr) {

      # Run through all votes belonging to a mail address.
      # If one vote is deleted it has also to be deleted from the array
      # so that the following addresses move up. In the other case the
      # counter is incremented as long as further votes are to be compared.

      my $n=0;
      while ($n<$#{$vaddr{$addr}}) {

        my $ask = 0;

        if ($votes[$vaddr{$addr}->[$n]]->{S} =~ /!/ ||
            $votes[$vaddr{$addr}->[$n+1]]->{S} =~ /!/)  {

          # One of the votes is invalid: Ask votetaker
          $ask = 1;

        } else {

          # Convert date into unixtime (str2time is located in Date::Parse)
          my $date1 = str2time($votes[$vaddr{$addr}->[$n]]->{D});
          my $date2 = str2time($votes[$vaddr{$addr}->[$n+1]]->{D});

          # compare dates
          my $order = $date1 <=> $date2;

          # first date is earlier
          if ($order == -1) {
            push(@deleted, $vaddr{$addr}->[$n]);
            # delete first element from the array
            splice(@{$vaddr{$addr}}, $n, 1);

          # second date is earlier
          } elsif ($order == 1) {
            push(@deleted, $vaddr{$addr}->[$n+1]);
            # delete second element from the array
            splice(@{$vaddr{$addr}}, $n+1, 1);

          # both are equal (ask votetaker)
          } else {
            $ask = 1;
          }

        }

        # Has votetaker to be asked?
        if ($ask) {
          my $default = 0;
          my $res = UVmenu::dup_choice($votes[$vaddr{$addr}->[0]],
                                       $votes[$vaddr{$addr}->[1]],
                                       $default);

          if ($res == 1) {
            push(@deleted, $vaddr{$addr}->[0]);
            # delete first element from the array
            splice(@{$vaddr{$addr}}, $n, 1);

          } elsif ($res == 2) {
            push(@deleted, $vaddr{$addr}->[1]);
            # delete second element from the array
            splice(@{$vaddr{$addr}}, $n+1, 1);

          } else {
            # don't delete anything: increment counter
            $n++;
          }
        }
      }
    }

    # the same for equal names:
    foreach my $name (keys %vnames) {
      my $n = 0;
      while ($n<$#{$vnames{$name}}) {

        # check if vote was already deleted by prior address sorting
        if (grep(/^$vnames{$name}->[$n]$/, @deleted)) {
          # delete first element from the array
          splice(@{$vnames{$name}}, $n, 1);
          next;

        } elsif (grep(/^$vnames{$name}->[$n+1]$/, @deleted)) {
          # delete second element from the array
          splice(@{$vnames{$name}}, $n+1, 1);
          next;
        }

        # Convert date into unixtime (str2time is located in Date::Parse)
        my $date1 = str2time($votes[$vnames{$name}->[$n]]->{D});
        my $date2 = str2time($votes[$vnames{$name}->[$n+1]]->{D});

        # Set default for menu choice to the earlier vote
        my $default = ($date2 < $date1) ? 2 : 0;

        my $res = UVmenu::dup_choice($votes[$vnames{$name}->[$n]],
                                     $votes[$vnames{$name}->[$n+1]],
                                     $default);

        # delete first
        if ($res == 1) {
          push(@deleted, $vnames{$name}->[$n]);
          splice(@{$vnames{$name}}, $n, 1);

        # delete second
        } elsif ($res == 2) {
          push(@deleted, $vnames{$name}->[$n+1]);
          # delete second element from the array
          splice(@{$vnames{$name}}, $n+1, 1);
       
        # don't delete anything: increment counter
        } else {
          $n++;
        }
      }
    }

    print STDERR UVmessage::get("COUNT_DELETED", (NUM=>scalar @deleted)), "\n\n";
  }

  # Count votes and generate voter list
  
  my $list_tpl = UVtemplate->new();
  $list_tpl->setKey('groupcount' => scalar @groups);

  # reversed order as caption string for last column comes first
  for (my $n=$#groups; $n>=0; $n--) {
    $list_tpl->addListItem('groups', pos=>@groups-$n, group=>$groups[$n]);
  }
   
  # loop through all addresses
  foreach my $addr (sort keys %vaddr) {

    # loop through all votes for every address
    for (my $n=0; $n<@{$vaddr{$addr}}; $n++) {

      # Ignore vote if already deleted.
      # If $nodup is not set one single vote should remain
      unless (grep(/^$vaddr{$addr}->[$n]$/, @deleted)) {

        # extract $vote for simplier code
        my $vote = $votes[$vaddr{$addr}->[$n]];

        # vote is invalid if there is an exclamation mark
        if ($vote->{S} =~ /!/) {
          $inv_count++;
        } else {
          # split vote string into single votes and count
          my @splitvote = split(//, $vote->{S});
          if (@groups != @splitvote) {
            die UVmessage::get("COUNT_ERR_GROUPCOUNT", (ADDR=>$addr, NUM1=>scalar @splitvote,
                      NUM2=>scalar @groups), RESULTFILE=>$config{resultfile}), "\n\n";
          }
          for (my $group=0; $group<@splitvote; $group++) {
            $votecount[$group]->{$splitvote[$group]}++;
          }
          $validcount++;
        }

        if ($opt_ctl{l} || $opt_ctl{v}) {

          # vote is invalid if there is an exclamation mark
          if ($vote->{S} =~ /!/) {
            $list_tpl->addListItem('invalid', (name=>$vote->{N}, mail=>$vote->{A}, reason=>$vote->{S}));

          # in other cases the vote is valid: generate list of votes
          } else {

            # one-group or multiple-group format?
            # must use multiple-group data structure for voter list (2. CfV)!
            if ($#groups || $opt_ctl{l}) {
              $list_tpl->addListItem('multi', (name=>$vote->{N}, mail=>$vote->{A}, vote=>$vote->{S}));
            } else {
              my ($votestring) = split(//, $vote->{S});
              $list_tpl->addListItem($varname{$votestring}, (name=>$vote->{N}, mail=>$vote->{A}));
            }

          }
        }
      }
    }
  }

  if ($opt_ctl{r}) {

    my $tplname;
    my $result_tpl = UVtemplate->new();
    $result_tpl->setKey('votename' => $config{votename});
    $result_tpl->setKey('numvalid' => $validcount);
    $result_tpl->setKey ('numinvalid', $inv_count);

    # proportional vote?
    if ($config{proportional}) {
      $tplname = $config{'tpl_result_prop'};
      for (my $group=0; $group<@votecount; $group++) {
        # calculate conditions
        my $yes = $votecount[$group]->{J};
        my $no = $votecount[$group]->{N};
        my $cond1 = eval $config{condition1};
        my $proportion = 0;

        # don't evaluate if division by zero
        unless ($config{prop_formula} =~ m#.+/(.+)# && eval($1)==0) {
          $proportion = eval $config{prop_formula};
        }
  
        # generate result line
        $result_tpl->addListItem('count', (yes        => $votecount[$group]->{J},
                                           no         => $votecount[$group]->{N},
                                           cond1      => $cond1,
                                           proportion => $proportion,
                                           result     => '', # must be set manually
                                           group      => $groups[$group]));
      }

    } else {
      # use one-group or multiple-group format?
      if (@groups == 1 && (!($config{multigroup} || $opt_ctl{m}) || $opt_ctl{o})) {
        $tplname = $config{'tpl_result_single'};
        my $yes = $votecount[0]->{J};
        my $no = $votecount[0]->{N};
        my $acc1 = eval $config{condition1};
        my $acc2 = eval $config{condition2};
        $result_tpl->setKey('yes' => $votecount[0]->{J});
        $result_tpl->setKey('no' => $votecount[0]->{N});
        $result_tpl->setKey('numabstain' => $votecount[0]->{E});
        $result_tpl->setKey('cond1' => $acc1);
        $result_tpl->setKey('cond2' => $acc2);

      } else {
        $tplname = $config{'tpl_result_multi'};
        $result_tpl->setKey('numabstain' => 0);

        for (my $group=0; $group<@votecount; $group++) {
          # calculate conditions
          my $yes = $votecount[$group]->{J};
          my $no = $votecount[$group]->{N};
          my $cond1 = eval $config{condition1};
          my $cond2 = eval $config{condition2};
  
          # generate result line
          $result_tpl->addListItem('count', (yes    => $votecount[$group]->{J},
                                             no     => $votecount[$group]->{N},
                                             cond1  => $cond1,
                                             cond2  => $cond2,
                                             result => ($cond1 && $cond2),
                                             group  => $groups[$group]));

        }
      }

      $result_tpl->setKey ('numabstain', $votecount[0]->{E}) if (@votecount == 1);
    }

    print $result_tpl->processTemplate($tplname);

  }

  if ($opt_ctl{v}) {

    # one-group or multiple-group format?
    if ($#groups) {
      print $list_tpl->processTemplate($config{'tpl_votes_multi'});
    } else {
      print $list_tpl->processTemplate($config{'tpl_votes_single'});
    }

  } elsif ($opt_ctl{l}) {
    print $list_tpl->processTemplate($config{'tpl_voterlist'});
  }

}


##############################################################################
# Print help text (options and syntax) on -h or --help                       #
##############################################################################

sub help {
  print STDERR <<EOF;
Usage: uvcount.pl [-c config_file] [-f result_file] [-l | -v] [-r [-m | -o]] [-n]
       uvcount.pl -h

Zaehlt Stimmen und gibt Waehlerlisten aus.

  -c config_file   liest die Konfiguration aus config_file
                   (usevote.cfg falls nicht angegeben)

  -f result_file   liest die Stimmen aus result_file (ueberschreibt
                   die "resultfile"-Angabe aus der Konfigurationsdatei)

  -l, --list       Gibt eine Liste aller Waehler aus (ohne Stimmen).

  -v, --voters     Wie -l, aber mit Angabe der abgegebenen Stimmen.

  -r, --result     Ausgabe des Endergebnisses (kann mit -l oder -v
                   kombiniert werden).

  -m, --multigroup Benutzt auch bei Eingruppenabstimmungen das
                   Mehrgruppenformat beim Endergebnis (ueberschreibt
                   die Einstellung aus usevote.cfg).
                   Nur in Kombination mit -r verwendbar, schliesst -o aus.

  -o, --onegroup   Benutzt bei Eingruppenabstimmungen immer das
                   Eingruppenformat beim Endergebnis (ueberschreibt
                   die Einstellung aus usevote.cfg).
                   Nur in Kombination mit -r verwendbar, schliesst -m aus.

  -n, --nodup      Verzichtet auf das Aussortieren von doppelten
                   Stimmabgaben. Nicht empfohlen!

  -h, --help       zeigt diesen Hilfetext an

EOF

  exit 0;
}
Commit	Line	Data
	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	}