X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?p=appendix-a6.git;a=blobdiff_plain;f=normalise;fp=normalise;h=7db074006a9f6627376b7e88ea5276c0b859318f;hp=6bf8ea664d7b54fce5b65f3c2faea20fe90a51d7;hb=7b6aa25ec2857da33d21b3f823f9301c7fb1cee3;hpb=7475a1f6fa0dde13e2be90b893fe4455acca98d9 diff --git a/normalise b/normalise index 6bf8ea6..7db0740 100755 --- a/normalise +++ b/normalise @@ -2,18 +2,26 @@ use strict; -our @options, %candiates, @ballots; +our @options; +our %candidates; # $candidates{CAND}{Desc}, {Opts}[] +our @ballots; my $candvoter_re = '\w+'; +sub badinput ($) { + die "bad input: $_[0]"; +} + sub normalise_opts_list ($) { + my ($os) = @_; + $os //= ''; my @o; foreach my $o (split /\s+/, $os) { if ($o =~ m/^\w+$/) { push @o, $&; } elsif ($o =~ m/^\w+\=\S+$/) { - push @o, $&;S - } elseif ($o !~ m/\S/) { + push @o, $&; + } elsif ($o !~ m/\S/) { } else { badinput "bad option \`$o'"; } @@ -34,7 +42,9 @@ while (<>) { s/\s+$//; if (m/^\|/) { push @options, normalise_opts_list $'; - } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*|(.*)?$/) { + } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) { + use Data::Dumper; +print STDERR Dumper($1,$2,$3); my ($cand,$desc,$opts) = ($1,$2,$3); push @{ $candidates{$cand}{Opts} }, normalise_opts $opts; if (length $desc) { @@ -42,15 +52,15 @@ while (<>) { defined $candidates{$cand}{Desc}; $candidates{$cand}{Desc} = $desc; } - $desc=$cand unless length $desc; - push @candidates, "$cand = $desc". - } elsif (m/^($candvoter_re?)?\s*\:([^|]+)(|(.*)?$/) { + } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) { my ($voter,$opts) = ($1,$3); my @p; foreach my $p (split /\s+/, $2) { if ($p =~ m/^\w+(?:\=\w+)*$/) { push @p, $&; - $candidates{$_} //= { } foreach my $p =~ m/\w+/g; + $candidates{$_} //= { } foreach $p =~ m/\w+/g; + } elsif ($p eq '') { + # empty entry can only happen if voter casts no prefs at all } else { badinput "bad vote preference \`$p'"; } @@ -75,6 +85,6 @@ foreach my $cand (sort keys %candidates) { sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; } print $_,"\n" or die $! foreach - (sort { vsortkey($a) cmp vsortkey($b) } @ballots; + sort { vsortkey($a) cmp vsortkey($b) } @ballots; print ".\n" or die $!;