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         if (m/^\s+[R ]\|/) {
  20             my @entries = split /\|/, $';
  21             $nboxcols ||= @entries;
  22             $nboxcols >= @entries or die;
  23             foreach my $cboxcol (0..$#entries) {
  24                 my $headix = $cboxcol + $cboxrow * $nboxcols;
  25                 $boxheads[$headix] //= '';
  26                 $boxheads[$headix] .= $entries[$cboxcol];
  27             }
  28         }
  29     }
  30
  31     s/\s+$// foreach @boxheads;
  32
  33     my @specials = qw(Exhausted Surplus Threshold);
  34     foreach my $si (0..$#specials) {
  35         my $hi = @boxheads - @specials + $si;
  36         die "$si $hi $boxheads[$hi] ?" unless $boxheads[$hi] eq $specials[$si];
  37         $boxheads[$hi] .= " "; # disambiguates
  38     }
  39 }
  40
  41 sub processbody () {
  42     my $cboxrow = 0;
  43     my %vals;
  44     my $donequota = 'X';
  45     while (<>) {
  46         if (m/^\s+\|--/) {
  47             if ($cboxrow >= 0) {
  48                 die unless $cboxrow;
  49                 die unless (scalar keys %vals) == @boxheads;
  50                 foreach my $k (sort grep { m/\S/ } keys %vals) {
  51                     print " candidate %10s : %20s votes\n" or die $!;
  52                 }
  53                 my $quota = $vals{'Threshold '};
  54                 if ($donequota ne $quota) {
  55                     print " quota %10d\n", $quota;
  56                     $donequota = $quota;
  57                 }
  58                 my $surplus = $vals{'Surplus '};
  59                 if ($surplus ne '0') {
  60                     print " surplus %10d\n", $surplus;
  61                 }
  62             }
  63             $cboxrow = -1;
  64             next;
  65         }
  66         if (m/^==/) {
  67             $cboxrow = 0;
  68             %vals = ();
  69             next;
  70         }
  71         if (m/^\s*(\d*)\|/) {
  72             die $cboxrow unless $cboxrow >= 0;
  73             die $cboxrow unless !!$cboxrow == !!length $1;
  74             if (length $1) {
  75                 print "stage Td:\n", $1 or die $!;
  76             }
  77             my @entries = split /\|/, $';
  78             $nboxcols >= @entries or die;
  79             foreach my $cboxcol (0..$#entries) {
  80                 my $headix = $cboxcol + $cboxrow * $nboxcols;
  81                 my $h = $boxheads[$headix];
  82                 defined $h or die;
  83                 die if exists $vals{$h};
  84                 my $e = $entries[$cboxcol];
  85                 $e =~ s/^\s+//;
  86                 $e =~ m/^\d*\.\d*$/ or die;
  87                 $e =~ m/\d/ or die;
  88                 $e =~ s/\.0+$//;
  89                 $vals{$h} = $e;
  90             }
  91         }
  92
  93
  94 }
  95
  96 parseheader();
  97 processbody();