#!/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

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!

Enter preference numbers for individual candidates. You may skip some candidates (which you absolutely do not wish to elect), but you must select at least one candidate. You must start numbering your candidates with number 1, all candidates must have a unique number and you must not skip any number.

2011/5 VII.8: Účastníci Valné hromady označí na volebních lístcích pořadí kandidátů připsáním čísla z nepřerušené řady přirozených čísel začínající jedničkou ke jménu kandidáta. Hlasovací lístek, který neobsahuje žádného označeného kandidáta nebo obsahuje alespoň dvě stejná čísla připsaná k různým kandidátům nebo takový, na kterém nejsou použita čísla z nepřerušené řady přirozených čísel, nebo žádný kandidát není označen číslem jedna, je neplatný.

If you wish to cast an invalid vote, check the invalid ballot checkbox.

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 if (not defined $pref or $pref eq ''); if (length $pref > 5) { print qq#

Length of preference for $name is # . (length $pref) . qq# which is just waaay too much. Please go back and try again.

#; exit; } $pref =~ s/\s*//g; unless ($pref =~ /^\d+$/) { $pref =~ s/[^\w\d.,-]//g; print qq#

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

#; exit; } if ($pref < 1 or $pref > @names) { print qq#

Preference for $name is $pref, which is out of the sensible range 1..# . (scalar @names) . qq#. 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 '') { 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