#!/usr/bin/perl use warnings; use strict; use v5.10; use CGI; our @names; open my $fh, "names-sample.txt" or die "$!"; while (<$fh>) { 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:

$name

Produce invalid ballot

EOT