X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~ian/git?a=blobdiff_plain;f=normalise;h=c5a9077365b97b96a34d66e16ca6f7861738193e;hb=8e0de3a8a82d07d9428f292a755d15ff3e5996ee;hp=6bf8ea664d7b54fce5b65f3c2faea20fe90a51d7;hpb=2ae008ee988080047f9a5576bc6f8a702ced2470;p=appendix-a6.git

diff --git a/normalise b/normalise
index 6bf8ea6..c5a9077 100755
--- a/normalise
+++ b/normalise
@@ -1,19 +1,39 @@
 #!/usr/bin/perl -w
+#
+# usage:
+#  normalise [NORM-OPTIONS...] [--] INPUT-FILES...
+#
+# NORM-OPTIONS are
+#   +OPTNAME[=OPTVAL]           Election option
+#   CAND=[DESCRIPTION]
+#   +CAND+OPTNAME[=OPTVAL]      Candidate option
+#   --                          End of options to normalise
+#   -...                        Reserved for future options to normalise
 
 use strict;
 
-our @options, %candiates, @ballots;
+our @options;
+our %candidates; # $candidates{CAND}{Desc}, {Opts}[]
+our @ballots;
 
 my $candvoter_re = '\w+';
+my $opt_re = '\w+(?:=\S*)?';
 
-sub normalise_opts_list ($) {
+sub badinput ($) {
+    die "bad input: $_[0]";
+}
+
+sub normalise_opts_list ($$) {
+    # $ctx is one of Election Candidate Ballot
+    my ($os,$ctx) = @_;
+    $os //= '';
     my @o;
     foreach my $o (split /\s+/, $os) {
 	if ($o =~ m/^\w+$/) {
 	    push @o, $&;
 	} elsif ($o =~ m/^\w+\=\S+$/) {
-	    push @o, $&;S
-	} elseif ($o !~ m/\S/) {
+	    push @o, $&;
+	} elsif ($o !~ m/\S/) {
 	} else {
 	    badinput "bad option \`$o'";
 	}
@@ -21,41 +41,68 @@ sub normalise_opts_list ($) {
     return @o;
 }
 
-sub normalise_opts ($) {
-    my ($os) = @_;
-    my @o = normalise_opts_list $os;
+sub normalise_opts ($$) {
+    my ($os,$ctx) = @_;
+    my @o = normalise_opts_list $os, $ctx;
     return " | @o";
 }
 
+sub setcanddesc ($$) {
+    my ($cand,$desc) = @_;
+
+    if (length $desc) {
+	badinput "multiple descriptions for $cand" if
+	    defined $candidates{$cand}{Desc};
+	$candidates{$cand}{Desc} = $desc;
+    }
+}
+
+while (@ARGV) {
+    $_ = shift @ARGV;
+    if (m/^--$/) {
+	last;
+    } elsif (m/^(\w+)=([^|]+)$/) {
+	setcanddesc $1, $2;
+    } elsif (m/^\+($opt_re)$/) {
+	push @options, $1;
+    } elsif (m/^\+(\w+)\+($opt_re)$/) {
+	push @{ $candidates{$1}{Opts} }, $2;
+    } elsif (m/^-/) {
+	die "unknown normalise option \`$_'\n";
+    } else {
+	# oh!
+	unshift @ARGV, $_;
+	last;
+    }
+}
+
 while (<>) {
     next unless m/\S/;
     next if m/^\#/;
     s/^\s+//;
     s/\s+$//;
     if (m/^\|/) {
-	push @options, normalise_opts_list $';
-    } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*|(.*)?$/) {
+	push @options, normalise_opts_list $', 'Election';
+    } elsif (m/^($candvoter_re?)\s*=\s*([^|]+?)\s*\|(.*)?$/o) {
+	use Data::Dumper;
+print STDERR Dumper($1,$2,$3);
 	my ($cand,$desc,$opts) = ($1,$2,$3);
-	push @{ $candidates{$cand}{Opts} }, normalise_opts $opts;
-	if (length $desc) {
-	    badinput "multiple descriptions for $cand" if
-		defined $candidates{$cand}{Desc};
-	    $candidates{$cand}{Desc} = $desc;
-	}
-	$desc=$cand unless length $desc;
-	push @candidates, "$cand = $desc".
-    } elsif (m/^($candvoter_re?)?\s*\:([^|]+)(|(.*)?$/) {
+	push @{ $candidates{$cand}{Opts} }, normalise_opts $opts, 'Candidate';
+	setcanddesc $cand, $desc;
+    } elsif (m/^($candvoter_re?)?\s*\:([^|]*)(?:\|(.*))?$/) {
 	my ($voter,$opts) = ($1,$3);
 	my @p;
 	foreach my $p (split /\s+/, $2) {
 	    if ($p =~ m/^\w+(?:\=\w+)*$/) {
 		push @p, $&;
-		$candidates{$_} //= { } foreach my $p =~ m/\w+/g;
+		$candidates{$_} //= { } foreach $p =~ m/\w+/g;
+	    } elsif ($p eq '') {
+		# empty entry can only happen if voter casts no prefs at all
 	    } else {
 		badinput "bad vote preference \`$p'";
 	    }
 	}
-	push @ballots, "$voter : @p".normalise_opts $opts;
+	push @ballots, "$voter : @p".normalise_opts $opts, 'Ballot';
     } elsif (m/^\.$/) {
     } else {
 	badinput "unknown line format \`$_'";
@@ -75,6 +122,6 @@ foreach my $cand (sort keys %candidates) {
 sub vsortkey { $_[0] =~ m/:/; return "$' : $`"; }
 
 print $_,"\n" or die $! foreach
-    (sort { vsortkey($a) cmp vsortkey($b) } @ballots;
+    sort { vsortkey($a) cmp vsortkey($b) } @ballots;
 
 print ".\n" or die $!;