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 while (<>) {
  39     next unless m/\S/;
  40     next if m/^\#/;
  41     s/^\s+//;
  42     s/\s+$//;
  43     if (m/^\|/) {
  44         push @options, normalise_opts_list $';
  45     } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
  46         use Data::Dumper;
  47 print STDERR Dumper($1,$2,$3);
  48         my ($cand,$desc,$opts) = ($1,$2,$3);
  49         push @{ $candidates{$cand}{Opts} }, normalise_opts $opts;
  50         if (length $desc) {
  51             badinput "multiple descriptions for $cand" if
  52                 defined $candidates{$cand}{Desc};
  53             $candidates{$cand}{Desc} = $desc;
  54         }
  55     } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
  56         my ($voter,$opts) = ($1,$3);
  57         my @p;
  58         foreach my $p (split /\s+/, $2) {
  59             if ($p =~ m/^\w+(?:\=\w+)*$/) {
  60                 push @p, $&;
  61                 $candidates{$_} //= { } foreach $p =~ m/\w+/g;
  62             } elsif ($p eq '') {
  63                 # empty entry can only happen if voter casts no prefs at all
  64             } else {
  65                 badinput "bad vote preference \`$p'";
  66             }
  67         }
  68         push @ballots, "$voter : @p".normalise_opts $opts;
  69     } elsif (m/^\.$/) {
  70     } else {
  71         badinput "unknown line format \`$_'";
  72     }
  73 }
  74
  75 print "| @options\n" or die $!;
  76
  77 foreach my $cand (sort keys %candidates) {
  78     my $c = $candidates{$cand};
  79     $c->{Desc} //= $cand;
  80     $c->{Opts} //= [ ];
  81     my $opts = $c->{Opts};
  82     print "$cand = $c->{Desc} | @$opts\n" or die $!;
  83 }
  84
  85 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
  86
  87 print $_,"\n" or die $! foreach
  88     sort { vsortkey($a) cmp vsortkey($b) } @ballots;
  89
  90 print ".\n" or die $!;