#!/usr/bin/perl use warnings; use strict; use v5.10; use CGI; my $label = 'testovaci komise'; my $votefile = "/home/pasky/votes $label.txt"; our @names; open my $fh, "names.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: $label

You can find your token on your paper ballot.
Keep your token secret until the vote is closed!
Udržujte svůj token v tajnosti, dokud není hlasování uzavřeno!

Sort individual candidates by preference.
If you do not wish to elect some candidates at all, do not assign any preference to them.
Do not leave any gaps in the preferences.

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

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

#; exit; } my %votes; open my $fh, $votefile or die "$!"; while (<$fh>) { chomp; my @b = split/,/; $votes{$b[0]} = [@b]; } close $fh; if (not $votes{$token}) { print qq#

No vote for this (valid) token has been cast.

#; exit; } else { my @vote = @{$votes{$token}}; shift @vote; print "\n"; for my $i (0..$#names) { print "\n"; } print "

".$names[$i]."

".$vote[$i]."

\n"; } exit; } if ($q->param('submit')) { 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; # XXX: We ignore $indices[0] for simplicity, we start indexing from 1 here! my %prefs; my $n_set = 0; my $over = 0; for my $i (1..@names) { my $pref = $q->param($i); if (not defined $pref or $pref eq '') { $over = 1; next; } if ($over > 0) { print qq#

Number $i has a candidate but some higher preference does not, which is not permitted. Please go back and try again.

#; exit; } if (not grep { $_ eq $pref } @names) { print qq#

Number $i has an unknown candidate $pref, are you trolling? Please go back and try again.

#; exit; } if (exists $prefs{$pref}) { print qq#

Candidate $pref is selected as both number $prefs{$pref} and $i, this is not permitted. Please go back and try again.

#; exit; } $prefs{$pref} = $i; $indices[$i] = $pref; } if (not keys %prefs) { print qq#

You must assign a preference 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, '>>' . $votefile 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