openstvoutput24compare

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4
   5 our $nboxcols;
   6 our @boxheads;
   7
   8 sub parseheader () {
   9     my $cboxrow = 0;
  10
  11     while (<>) {
  12         last if m/^==/;
  13         next unless m/^ R/..0;
  14
  15         if (m/^\s+\|[-+]+\s*$/) {
  16             $cboxrow++;
  17             next;
  18         }
  19         s/\n$//;
  20         if (m/^\s+[R ]\|/) {
  21             my @entries = split /\|/, $';
  22             $nboxcols ||= @entries;
  23             $nboxcols >= @entries or die;
  24             foreach my $cboxcol (0..$#entries) {
  25                 my $headix = $cboxcol + $cboxrow * $nboxcols;
  26                 $boxheads[$headix] //= '';
  27                 $boxheads[$headix] .= $entries[$cboxcol];
  28             }
  29         }
  30     }
  31
  32     s/\s+$// foreach @boxheads;
  33
  34     my @specials = qw(Exhausted Surplus Threshold);
  35     foreach my $si (0..$#specials) {
  36         my $hi = @boxheads - @specials + $si;
  37         die "$si $hi $boxheads[$hi] ?" unless $boxheads[$hi] eq $specials[$si];
  38         $boxheads[$hi] .= " "; # disambiguates
  39     }
  40 }
  41
  42 sub processbody () {
  43     my $cboxrow = 0;
  44     my %vals;
  45     my $donequota = 'X';
  46     while (<>) {
  47         s/\n$//;
  48         if (m/^\s+\|--/) {
  49             if ($cboxrow >= 0) {
  50                 die unless $cboxrow;
  51                 die unless (scalar keys %vals) == @boxheads;
  52                 foreach my $k (sort grep { !m/ $/ } keys %vals) {
  53                     my $e = $vals{$k};
  54                     next unless length $e;
  55                     printf " candidate %-10s : %20s votes\n",
  56                         $k, $e
  57                         or die $!;
  58                 }
  59                 my $quota = $vals{'Threshold '};
  60                 if ($donequota ne $quota) {
  61                     printf " quota   %10s\n", $quota;
  62                     $donequota = $quota;
  63                 }
  64                 my $surplus = $vals{'Surplus '};
  65                 if ($surplus ne '0') {
  66                     printf " surplus %10s\n", $surplus;
  67                 }
  68             }
  69             $cboxrow = -1;
  70             next;
  71         }
  72         if (m/^==/) {
  73             $cboxrow = 0;
  74             %vals = ();
  75             next;
  76         }
  77         if (m/^\s*(\d*)\|/) {
  78             next unless $cboxrow >= 0;
  79             die "$cboxrow $1" unless !$cboxrow == !!length $1;
  80             if (length $1) {
  81                 printf "stage %d:\n", $1 or die $!;
  82             }
  83             my @entries = split /\|/, $';
  84             $nboxcols >= @entries or die;
  85             foreach my $cboxcol (0..$#entries) {
  86                 my $headix = $cboxcol + $cboxrow * $nboxcols;
  87                 my $h = $boxheads[$headix];
  88                 defined $h or die;
  89                 die if exists $vals{$h};
  90                 my $e = $entries[$cboxcol];
  91                 $e =~ s/^\s+//;
  92                 if (length $e) {
  93                     $e =~ m/^\d*\.\d*$/ or die;
  94                     $e =~ m/\d/ or die;
  95                     $e =~ s/\.0+$//;
  96                 }
  97                 $vals{$h} = $e;
  98             }
  99             $cboxrow++;
 100             next;
 101         }
 102         if (!m/\S/) {
 103             last;
 104         }
 105         die;
 106     }
 107 }
 108
 109 sub processfinal () {
 110     while (<>) {
 111         s/\n$//;
 112         if (s/^Winners are //) {
 113             s/\.$//;
 114             my @w = split /\, /;
 115             if (@w == 1) {
 116                 @w = split / and /, $w[0];
 117             } else {
 118                 $w[$#w] =~ s/^and //;
 119             }
 120             print "Winners:\n";
 121             @w = sort @w;
 122             foreach my $i (0..$#w) {
 123                 printf "  %s\n", $w[$i];
 124             }
 125             print "done.\n";
 126         }
 127     }
 128 }
 129
 130 parseheader();
 131 processbody();
 132 processfinal();