normalise

   1 #!/usr/bin/perl -w
   2 #
   3 # usage:
   4 #  normalise [NORM-OPTIONS...] [--] INPUT-FILES...
   5 #
   6 # NORM-OPTIONS are
   7 #   +OPTNAME[=OPTVAL]           Election option
   8 #   CAND=[DESCRIPTION]
   9 #   +CAND+OPTNAME[=OPTVAL]      Candidate option
  10 #   --                          End of options to normalise
  11 #   -...                        Reserved for future options to normalise
  12
  13 use strict;
  14
  15 our @options;
  16 our %candidates; # $candidates{CAND}{Desc}, {Opts}[]
  17 our @ballots;
  18
  19 my $candvoter_re = '\w+';
  20 my $opt_re = '\w+(?:=\S*)?';
  21
  22 sub badinput ($) {
  23     die "bad input: $_[0]";
  24 }
  25
  26 sub normalise_opts_list ($$) {
  27     # $ctx is one of Election Candidate Ballot
  28     my ($os,$ctx) = @_;
  29     $os //= '';
  30     my @o;
  31     foreach my $o (split /\s+/, $os) {
  32         if ($o =~ m/^\w+$/) {
  33             push @o, $&;
  34         } elsif ($o =~ m/^\w+\=\S+$/) {
  35             push @o, $&;
  36         } elsif ($o !~ m/\S/) {
  37         } else {
  38             badinput "bad option \`$o'";
  39         }
  40     }
  41     return @o;
  42 }
  43
  44 sub normalise_opts ($$) {
  45     my ($os,$ctx) = @_;
  46     my @o = normalise_opts_list $os, $ctx;
  47     return " | @o";
  48 }
  49
  50 sub setcanddesc ($$) {
  51     my ($cand,$desc) = @_;
  52
  53     if (length $desc) {
  54         badinput "multiple descriptions for $cand" if
  55             defined $candidates{$cand}{Desc};
  56         $candidates{$cand}{Desc} = $desc;
  57     }
  58 }
  59
  60 while (@ARGV) {
  61     $_ = shift @ARGV;
  62     if (m/^--$/) {
  63         last;
  64     } elsif (m/^(\w+)=([^|]+)$/) {
  65         setcanddesc $1, $2;
  66     } elsif (m/^\+($opt_re)$/) {
  67         push @options, $1;
  68     } elsif (m/^\+(\w+)\+($opt_re)$/) {
  69         push @{ $candidates{$1}{Opts} }, $2;
  70     } elsif (m/^-/) {
  71         die "unknown normalise option \`$_'\n";
  72     } else {
  73         # oh!
  74         unshift @ARGV, $_;
  75         last;
  76     }
  77 }
  78
  79 while (<>) {
  80     next unless m/\S/;
  81     next if m/^\#/;
  82     s/^\s+//;
  83     s/\s+$//;
  84     if (m/^\|/) {
  85         push @options, normalise_opts_list $', 'Election';
  86     } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
  87         use Data::Dumper;
  88 print STDERR Dumper($1,$2,$3);
  89         my ($cand,$desc,$opts) = ($1,$2,$3);
  90         push @{ $candidates{$cand}{Opts} }, normalise_opts $opts, 'Candidate';
  91         setcanddesc $cand, $desc;
  92     } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
  93         my ($voter,$opts) = ($1,$3);
  94         my @p;
  95         foreach my $p (split /\s+/, $2) {
  96             if ($p =~ m/^\w+(?:\=\w+)*$/) {
  97                 push @p, $&;
  98                 $candidates{$_} //= { } foreach $p =~ m/\w+/g;
  99             } elsif ($p eq '') {
 100                 # empty entry can only happen if voter casts no prefs at all
 101             } else {
 102                 badinput "bad vote preference \`$p'";
 103             }
 104         }
 105         push @ballots, "$voter : @p".normalise_opts $opts, 'Ballot';
 106     } elsif (m/^\.$/) {
 107     } else {
 108         badinput "unknown line format \`$_'";
 109     }
 110 }
 111
 112 print "| @options\n" or die $!;
 113
 114 foreach my $cand (sort keys %candidates) {
 115     my $c = $candidates{$cand};
 116     $c->{Desc} //= $cand;
 117     $c->{Opts} //= [ ];
 118     my $opts = $c->{Opts};
 119     print "$cand = $c->{Desc} | @$opts\n" or die $!;
 120 }
 121
 122 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
 123
 124 print $_,"\n" or die $! foreach
 125     sort { vsortkey($a) cmp vsortkey($b) } @ballots;
 126
 127 print ".\n" or die $!;