From a6101aa02a3123090f96d9a36d47bca160947ca8 Mon Sep 17 00:00:00 2001 From: Petr Baudis Date: Wed, 8 Oct 2014 22:51:33 +0200 Subject: [PATCH] web-ballot.pl: New script --- README.md | 16 ++++++- web-ballot.pl | 129 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 143 insertions(+), 2 deletions(-) create mode 100755 web-ballot.pl diff --git a/README.md b/README.md index 3fa2b3e..827e50b 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,15 @@ -Example: +Generating Ballots +------------------ -./gen-ballot.pl 15 ) { + chomp; + push @names, $_; +} +close $fh; + +our @tokens; +open $fh, "tokens.txt" or die "$!"; +while (<$fh>) { + chomp; + push @tokens, $_; +} +close $fh; + +my $q = CGI->new; +print $q->header(-charset => 'utf-8'); + +print < + brmelect Web Ballot + + +

brmelect Web Ballot

+ +EOT + + +if ($q->param('go')) { + my $token = $q->param('token'); + unless (grep { $_ eq $token } @tokens) { + print qq#

ERROR: Unknown token specified. Please go back and try again.

#; + exit; + } + + my $votestr; + unless ($q->param('invalid')) { + my @indices; + for (0..@names) { + $indices[$_] = ''; + } + # XXX: We ignore $indices[0] for simplicity, we start indexing from 1 here! + my %prefs; + my $n_set = 0; + + for my $name (@names) { + my $pref = $q->param($name); + next unless ($pref); + unless ($pref =~ /^\d+$/) { + print qq#

Preference for $name is $pref, which is not a number. Please go back and try again.

#; + exit; + } + if ($indices[$pref] ne '') { + print qq#

Preference for $name is $pref, but this number is already also used for the candidate '$indices[$pref]'. Please go back and try again.

#; + exit; + } + $indices[$pref] = $name; + $prefs{$name} = $pref; + $n_set++; + } + + for my $i (1..$n_set) { + if ($indices[$i] eq '') { + print qq#

Number $i was left unused, which is not permitted. Please go back and try again.

#; + exit; + } + } + for my $i (($n_set+1)..$#indices) { + if ($indices[$i] ne '') { + print qq#

Number $i was used out of uninterrupted natural number sequence, which is not permitted. Please go back and try again.

#; + exit; + } + } + + if ($indices[1] eq 0) { + print qq#

You must assign a preference (1) to at least one candidate. Please go back and try again.

#; + exit; + } + + $votestr = join(',', $token, map { $prefs{$_} or 0 } @names); + } else { + $votestr = join(',', $token, map { 'x' } @names); + } + + print STDERR "$votestr\n"; + + open $fh, '>>/home/pasky/votes.txt' or die "$!"; + print $fh "$votestr\n"; + close $fh; + + (my $rvotestr = $votestr) =~ s/^.*?,//; + print qq#

Success. Your vote ($rvotestr) has been saved. You may still revise your vote before the closing call if you wish, but do NOT cast a paper ballot at this point anymore!

\n#; + + exit; +} + +print < +
+

Token:

+
    +EOT + +for my $name (@names) { + print qq#
  • $name
    • \n#; +} + +print < +

    Produce invalid ballot

    +
+

+ + + +EOT