normalise

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