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     my ($os) = @_;
  28     $os //= '';
  29     my @o;
  30     foreach my $o (split /\s+/, $os) {
  31         if ($o =~ m/^\w+$/) {
  32             push @o, $&;
  33         } elsif ($o =~ m/^\w+\=\S+$/) {
  34             push @o, $&;
  35         } elsif ($o !~ m/\S/) {
  36         } else {
  37             badinput "bad option \`$o'";
  38         }
  39     }
  40     return @o;
  41 }
  42
  43 sub normalise_opts ($) {
  44     my ($os) = @_;
  45     my @o = normalise_opts_list $os;
  46     return " | @o";
  47 }
  48
  49 sub setcanddesc ($$) {
  50     my ($cand,$desc) = @_;
  51
  52     if (length $desc) {
  53         badinput "multiple descriptions for $cand" if
  54             defined $candidates{$cand}{Desc};
  55         $candidates{$cand}{Desc} = $desc;
  56     }
  57 }
  58
  59 while (@ARGV) {
  60     $_ = shift @ARGV;
  61     if (m/^--$/) {
  62         last;
  63     } elsif (m/^(\w+)=([^|]+)$/) {
  64         setcanddesc $1, $2;
  65     } elsif (m/^\+($opt_re)$/) {
  66         push @options, $1;
  67     } elsif (m/^\+(\w+)\+($opt_re)$/) {
  68         push @{ $candidates{$1}{Opts} }, $2;
  69     } elsif (m/^-/) {
  70         die "unknown normalise option \`$_'\n";
  71     } else {
  72         # oh!
  73         unshift @ARGV, $_;
  74         last;
  75     }
  76 }
  77
  78 while (<>) {
  79     next unless m/\S/;
  80     next if m/^\#/;
  81     s/^\s+//;
  82     s/\s+$//;
  83     if (m/^\|/) {
  84         push @options, normalise_opts_list $';
  85     } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
  86         use Data::Dumper;
  87 print STDERR Dumper($1,$2,$3);
  88         my ($cand,$desc,$opts) = ($1,$2,$3);
  89         push @{ $candidates{$cand}{Opts} }, normalise_opts $opts;
  90         setcanddesc $cand, $desc;
  91     } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
  92         my ($voter,$opts) = ($1,$3);
  93         my @p;
  94         foreach my $p (split /\s+/, $2) {
  95             if ($p =~ m/^\w+(?:\=\w+)*$/) {
  96                 push @p, $&;
  97                 $candidates{$_} //= { } foreach $p =~ m/\w+/g;
  98             } elsif ($p eq '') {
  99                 # empty entry can only happen if voter casts no prefs at all
 100             } else {
 101                 badinput "bad vote preference \`$p'";
 102             }
 103         }
 104         push @ballots, "$voter : @p".normalise_opts $opts;
 105     } elsif (m/^\.$/) {
 106     } else {
 107         badinput "unknown line format \`$_'";
 108     }
 109 }
 110
 111 print "| @options\n" or die $!;
 112
 113 foreach my $cand (sort keys %candidates) {
 114     my $c = $candidates{$cand};
 115     $c->{Desc} //= $cand;
 116     $c->{Opts} //= [ ];
 117     my $opts = $c->{Opts};
 118     print "$cand = $c->{Desc} | @$opts\n" or die $!;
 119 }
 120
 121 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
 122
 123 print $_,"\n" or die $! foreach
 124     sort { vsortkey($a) cmp vsortkey($b) } @ballots;
 125
 126 print ".\n" or die $!;