chiark / gitweb /
normalise: introduce setcanddesc
[appendix-a6.git] / normalise
1 #!/usr/bin/perl -w
2
3 use strict;
4
5 our @options;
6 our %candidates; # $candidates{CAND}{Desc}, {Opts}[]
7 our @ballots;
8
9 my $candvoter_re = '\w+';
10
11 sub badinput ($) {
12     die "bad input: $_[0]";
13 }
14
15 sub normalise_opts_list ($) {
16     my ($os) = @_;
17     $os //= '';
18     my @o;
19     foreach my $o (split /\s+/, $os) {
20         if ($o =~ m/^\w+$/) {
21             push @o, $&;
22         } elsif ($o =~ m/^\w+\=\S+$/) {
23             push @o, $&;
24         } elsif ($o !~ m/\S/) {
25         } else {
26             badinput "bad option \`$o'";
27         }
28     }
29     return @o;
30 }
31
32 sub normalise_opts ($) {
33     my ($os) = @_;
34     my @o = normalise_opts_list $os;
35     return " | @o";
36 }
37
38 sub setcanddesc ($$) {
39     my ($cand,$desc) = @_;
40
41     if (length $desc) {
42         badinput "multiple descriptions for $cand" if
43             defined $candidates{$cand}{Desc};
44         $candidates{$cand}{Desc} = $desc;
45     }
46 }
47
48 while (<>) {
49     next unless m/\S/;
50     next if m/^\#/;
51     s/^\s+//;
52     s/\s+$//;
53     if (m/^\|/) {
54         push @options, normalise_opts_list $';
55     } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
56         use Data::Dumper;
57 print STDERR Dumper($1,$2,$3);
58         my ($cand,$desc,$opts) = ($1,$2,$3);
59         push @{ $candidates{$cand}{Opts} }, normalise_opts $opts;
60         setcanddesc $cand, $desc;
61     } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
62         my ($voter,$opts) = ($1,$3);
63         my @p;
64         foreach my $p (split /\s+/, $2) {
65             if ($p =~ m/^\w+(?:\=\w+)*$/) {
66                 push @p, $&;
67                 $candidates{$_} //= { } foreach $p =~ m/\w+/g;
68             } elsif ($p eq '') {
69                 # empty entry can only happen if voter casts no prefs at all
70             } else {
71                 badinput "bad vote preference \`$p'";
72             }
73         }
74         push @ballots, "$voter : @p".normalise_opts $opts;
75     } elsif (m/^\.$/) {
76     } else {
77         badinput "unknown line format \`$_'";
78     }
79 }
80
81 print "| @options\n" or die $!;
82
83 foreach my $cand (sort keys %candidates) {
84     my $c = $candidates{$cand};
85     $c->{Desc} //= $cand;
86     $c->{Opts} //= [ ];
87     my $opts = $c->{Opts};
88     print "$cand = $c->{Desc} | @$opts\n" or die $!;
89 }
90
91 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
92
93 print $_,"\n" or die $! foreach
94     sort { vsortkey($a) cmp vsortkey($b) } @ballots;
95
96 print ".\n" or die $!;