+#!/usr/bin/perl -w
+
+use strict;
+
+our $nboxcols;
+our @boxheads;
+
+sub parseheader () {
+ my $cboxrow = 0;
+
+ while (<>) {
+ last if m/^==/;
+ next unless m/^ R/..0;
+
+ if (m/^\s+\|[-+]+\s*$/) {
+ $cboxrow++;
+ next;
+ }
+ if (m/^\s+[R ]\|/) {
+ my @entries = split /\|/, $';
+ $nboxcols ||= @entries;
+ $nboxcols >= @entries or die;
+ foreach my $cboxcol (0..$#entries) {
+ my $headix = $cboxcol + $cboxrow * $nboxcols;
+ $boxheads[$headix] //= '';
+ $boxheads[$headix] .= $entries[$cboxcol];
+ }
+ }
+ }
+
+ s/\s+$// foreach @boxheads;
+
+ my @specials = qw(Exhausted Surplus Threshold);
+ foreach my $si (0..$#specials) {
+ my $hi = @boxheads - @specials + $si;
+ die "$si $hi $boxheads[$hi] ?" unless $boxheads[$hi] eq $specials[$si];
+ $boxheads[$hi] .= " "; # disambiguates
+ }
+}
+
+sub processbody () {
+ my $cboxrow = 0;
+ my %vals;
+ my $donequota = 'X';
+ while (<>) {
+ if (m/^\s+\|--/) {
+ if ($cboxrow >= 0) {
+ die unless $cboxrow;
+ die unless (scalar keys %vals) == @boxheads;
+ foreach my $k (sort grep { m/\S/ } keys %vals) {
+ print " candidate %10s : %20s votes\n" or die $!;
+ }
+ my $quota = $vals{'Threshold '};
+ if ($donequota ne $quota) {
+ print " quota %10d\n", $quota;
+ $donequota = $quota;
+ }
+ my $surplus = $vals{'Surplus '};
+ if ($surplus ne '0') {
+ print " surplus %10d\n", $surplus;
+ }
+ }
+ $cboxrow = -1;
+ next;
+ }
+ if (m/^==/) {
+ $cboxrow = 0;
+ %vals = ();
+ next;
+ }
+ if (m/^\s*(\d*)\|/) {
+ die $cboxrow unless $cboxrow >= 0;
+ die $cboxrow unless !!$cboxrow == !!length $1;
+ if (length $1) {
+ print "stage Td:\n", $1 or die $!;
+ }
+ my @entries = split /\|/, $';
+ $nboxcols >= @entries or die;
+ foreach my $cboxcol (0..$#entries) {
+ my $headix = $cboxcol + $cboxrow * $nboxcols;
+ my $h = $boxheads[$headix];
+ defined $h or die;
+ die if exists $vals{$h};
+ my $e = $entries[$cboxcol];
+ $e =~ s/^\s+//;
+ $e =~ m/^\d*\.\d*$/ or die;
+ $e =~ m/\d/ or die;
+ $e =~ s/\.0+$//;
+ $vals{$h} = $e;
+ }
+ }
+
+
+}
+
+parseheader();
+processbody();