openstvoutput24compare; wip

diff --git a/openstvoutput24compare b/openstvoutput24compare
new file mode 100755 (executable)
index 0000000..be52f7a
--- /dev/null
+++ b/openstvoutput24compare
@@ -0,0 +1,97 @@
+#!/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();