mop/eval/mo-score.sh

   1 #!/usr/bin/perl
   2 # A generator of score sheets. More ugly than it deserves.
   3
   4 $debug = 0;
   5 $detail = 0;
   6 $html = 0;
   7 $tex = 0;
   8 $extras = 0;
   9 $alt = 0;
  10 $merged = 0;
  11 $table = 0;
  12 $usage = "Usage: mo-score [--detail] [--alt] [--extras] [--html] [--tex] [--table] [--merged] [<directory>/]<task> ...";
  13 while (($arg = $ARGV[0]) =~ /^--([a-z]+)$/) {
  14         shift @ARGV;
  15         $var = "\$$1";
  16         if (!eval "defined $var") { die $usage; }
  17         eval "$var = 1;";
  18 }
  19 @ARGV || die $usage;
  20
  21 $print_key = 1;
  22 if ($table) {
  23         open STDOUT, "|column -t -s'\t'" or die;
  24         $print_key = 0;
  25 }
  26
  27 print STDERR "Scanning contestants... ";
  28 open (CT, "bin/mo-get-users --full |") || die "Cannot get list of contestants";
  29 while (<CT>) {
  30         chomp;
  31         ($u,$f) = split /\t/;
  32         ($u eq "somebody") && next;
  33         $users{$u}=$f;
  34 }
  35 close CT;
  36 print STDERR 0+keys %users, "\n";
  37
  38 print STDERR "Scanning exceptions... ";
  39 if ($extras && open (EX, "exceptions")) {
  40         while (<EX>) {
  41                 chomp;
  42                 (/^$/ || /^#/) && next;
  43                 @a = split /\s+/;
  44                 $u = shift @a;
  45                 defined $users{$u} || die "Unknown user $u";
  46                 while (@a) { $extra{$u} += shift @a; }
  47         }
  48         close EX;
  49         print STDERR "OK\n";
  50 } else { print STDERR "none\n"; }
  51
  52 print STDERR "Scanning task results... ";
  53 %messages = ();
  54 %error_codes = ();
  55 foreach $u (keys %users) {
  56         foreach $task (@ARGV) {
  57                 my ($dir, $t) = ("testing", $task);
  58                 if ($task =~ m@^(.*)/([^/]*)$@) {
  59                         $dir = $1;
  60                         $t = $2;
  61                 }
  62                 $known_tasks{$t} = 1;
  63                 $tt = "$dir/$u/$t/points" . ($alt ? ".alt" : "");
  64                 -f $tt || next;
  65                 print STDERR "$u/$t ";
  66                 open (X, $tt) || die "Unable to open $tt";
  67                 while (<X>) {
  68                         chomp;
  69                         /^(\S+) (-?\d+)\s*(.*)/ || die "Parse error: $_";
  70                         $ttest = $1;
  71                         $tpts = $2;
  72                         $trem = $3;
  73                         $trem =~ s/\[.*//;
  74                         ($ttest_merged = $ttest) =~ s/[^0-9]//g;
  75                         $ttest = $ttest_merged if $merged;
  76                         $known_tests{$t}{$ttest} = 1;
  77                         $cmt = $tpts;
  78                         if ($tpts == 0 && $trem ne "OK") {
  79                                 if ($trem =~ /^Compile /) { $cmt = "CE"; }
  80                                 elsif ($trem =~ /^Time limit exceeded/) { $cmt = "TO"; }
  81                                 elsif ($trem =~ /^Exited with error /) { $cmt = "RE"; }
  82                                 elsif ($trem =~ /^Caught fatal signal /) { $cmt = "SG"; }
  83                                 elsif ($trem =~ /^([A-Za-z])\S*\s+([A-Za-z])/) {
  84                                         ($cmt = "$1$2") =~ tr/a-z/A-Z/;
  85                                 }
  86                                 if (!defined $messages{$trem}) {
  87                                         $messages{$trem} = $cmt;
  88                                         if (!defined $error_codes{$cmt}) {
  89                                                 $error_codes{$cmt} = $trem;
  90                                         } else {
  91                                                 $error_codes{$cmt} .= ", $trem";
  92                                         }
  93                                 }
  94                         }
  95                         if (!defined($results{$u}{$t}{$ttest}) || $results{$u}{$t}{$ttest} > $tpts) {
  96                                 $results{$u}{$t}{$ttest} = $tpts;
  97                                 $comment{$u}{$t}{$ttest} = $cmt;
  98                         }
  99                         if (!defined($results_merged{$u}{$t}{$ttest_merged}) || $results_merged{$u}{$t}{$ttest_merged} > $tpts) {
 100                                 $results_merged{$u}{$t}{$ttest_merged} = $tpts;
 101                         }
 102                 }
 103                 close X;
 104         }
 105         foreach my $t (keys %known_tasks) {
 106                 $total{$u}{$t} = 0;
 107                 foreach my $pts (values %{$results_merged{$u}{$t}}) { $total{$u}{$t} += $pts; }
 108         }
 109 }
 110 print STDERR "OK\n";
 111
 112 print STDERR "Creating table template... ";
 113 @header = ("Rank","User","Name");
 114 @body = ('','$u','$users{$u}');
 115 @bodysums = ();
 116 @footer = ('"Total"','','');
 117 if (keys %extra) {
 118         push @header, "Extra";
 119         push @body, '$extra{$u}';
 120         $col = 0+@footer;
 121         push @bodysums, $col;
 122         push @footer, "sum($col)";
 123 }
 124 @tasks = ();
 125 foreach $task (@ARGV) {
 126         my $t = ($task =~ m@/([^/]*)$@) ? $1 : $task;
 127         defined $known_tasks{$t} || die "Unknown task $t";
 128         push @tasks, $t;
 129         push @header, substr($t, 0, 4);
 130         push @body, "(\$xx = \$total{\$u}{'$t'}) > 0 ? \$xx : 0";
 131         $col = 0+@footer;
 132         push @footer, "sum($col)";
 133         push @bodysums, $col;
 134         if ($detail) {
 135                 foreach $s (sort { $a <=> $b } keys %{$known_tests{$t}}) {
 136                         push @header, "$s";
 137                         push @body, "\$comment{\$u}{'$t'}{'$s'}";
 138                         $col = 0+@footer;
 139                         push @footer, "sum($col)";
 140                 }
 141         }
 142 }
 143 push @header, "Total";
 144 push @body, join('+', map { $_ = "\$$_" } @bodysums);
 145 $col = 0+@footer;
 146 push @footer, "sum($col)";
 147 print STDERR "OK\n";
 148
 149 print STDERR "h: ", join(':',@header), "\n" if $debug;
 150 print STDERR "b: ", join(':',@body), "\n" if $debug;
 151 print STDERR "f: ", join(':',@footer), "\n" if $debug;
 152
 153 print STDERR "Filling in results... ";
 154 @table = ();
 155 foreach $u (keys %users) {
 156         $row = [];
 157         foreach my $c (@body) {
 158                 $c =~ s/\$(\d+)/\$\$row[$1]/g;
 159                 $x = eval $c;
 160                 push @$row, (defined $x ? $x : '-');
 161         }
 162         print STDERR "row: ", join(':',@$row), "\n" if $debug;
 163         push @table, $row;
 164 }
 165 print STDERR "OK\n";
 166
 167 print STDERR "Sorting... ";
 168 $sortcol = @{$table[0]} - 1;
 169 $namecol = 2;
 170 @table = sort {
 171         my $p, $an, $bn;
 172         $p = $$b[$sortcol] <=> $$a[$sortcol];
 173         ($an = $$a[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
 174         ($bn = $$b[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
 175         $p ? $p : ($an cmp $bn);
 176 } @table;
 177 $i=0;
 178 while ($i < @table) {
 179         $j = $i;
 180         while ($i < @table && ${$table[$i]}[$sortcol] == ${$table[$j]}[$sortcol]) {
 181                 $i++;
 182         }
 183         if ($i == $j+1) {
 184                 ${table[$j]}[0] = "$i.";
 185         } else {
 186                 ${table[$j]}[0] = $j+1 . ".-" . $i . ".";
 187                 $j++;
 188                 while ($j < $i) { ${table[$j++]}[0] = ""; };
 189         }
 190 }
 191 print STDERR "OK\n";
 192
 193 print STDERR "Attaching headers and footers... ";
 194 sub sum { my $col=shift @_; my $t=0; foreach my $z (0..@table-1) { $t += ${$table[$z]}[$col]; } $t; }
 195 map { $_ = eval $_; } @footer;
 196 push @table, \@footer;
 197 unshift @table, \@header;
 198 print STDERR "OK\n";
 199
 200 if ($debug) {
 201         foreach $r (@table) { print join(':',@$r), "\n"; }
 202 } elsif ($html) {
 203         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">', "\n";
 204         print "<HTML><HEAD><TITLE>Rank list</TITLE></HEAD><BODY>\n";
 205         print "<H1>Rank list</H1>\n";
 206
 207         my @perm;
 208         &printHtmlHeader(\@perm);
 209         print "<tbody>";
 210
 211         foreach $r (@table[1..($#table - 1)]) {
 212                 &printHtmlRow(@{$r}[@perm]);
 213         }
 214
 215         print "<tbody>";
 216         &printHtmlRow(@{$table[$#table]}[@perm]);
 217
 218         print "</TABLE>\n";
 219         if ($detail) {
 220                 print "<H2>Error codes</H2><UL>\n";
 221                 foreach $r (sort keys %error_codes) { print "<LI>$r: $error_codes{$r}\n"; }
 222                 print "</UL>\n";
 223         }
 224         print "</BODY></HTML>\n";
 225 } elsif ($tex) {
 226         print "\\error{TeX output not supported yet!}\n";
 227 } else {
 228         foreach $r (@table) { print join("\t",@$r), "\n"; }
 229         if ($print_key) {
 230                 print "\n";
 231                 foreach $r (sort keys %error_codes) { print "$r: $error_codes{$r}\n"; }
 232         }
 233 }
 234
 235 sub printHtmlRow {
 236         print "<TR>", join('',map {
 237                 if ($hdr) { $_ = "<TH>$_"; }
 238                 else { $_ = "<TD align=" . (/^[0-9A-Z-]+$/ ? "right" : "left") . (length($_) > 14 ? " width=150" : "") . ">$_"; }
 239         } @_), "\n";
 240 }
 241
 242 sub printHtmlHeader {
 243
 244   my ($perm) = @_;
 245
 246    my $colspec = "<colgroup span=3>";
 247    my $hdr1;
 248    my $hdr2;
 249
 250    @$perm = (0, 1, 2);
 251    my $p = 3;
 252
 253    if ($detail) {
 254      $hdr1 = "<th rowspan=2>Rank<th rowspan=2>User<th rowspan=2>Name";
 255      $extras and $p++ and push @$perm, 3 and $hdr1.="<th rowspan=2>Extra" and $colspec.="<colgroup span=1>";         ##Extra hack
 256      for my $task (@tasks) {
 257
 258         my $nSub = scalar(keys %{$known_tests{$task}});
 259
 260         $p++;
 261         map { push @$perm, $p++ } (1..$nSub);
 262         push @$perm, $p - $nSub - 1;
 263
 264         $colspec .= "<colgroup span='" . $nSub . "'>\n";
 265         $colspec .= "<colgroup span='1'>\n";
 266         $hdr1 .= "<th colspan='" . ($nSub + 1) . "' style='border-bottom:1px solid black;'>$task";
 267         $hdr2 .= join("", map { "<th>$_" } sort {$a <=> $b} keys %{$known_tests{$task}});
 268         $hdr2 .= "<th>Total";
 269      }
 270
 271      $hdr1 .= "<th rowspan='2'>Total";
 272
 273    } else {  ## no detail
 274
 275      $hdr1 = "<th>Rank<th>User<th>Name";
 276      $extras and $p++ and push @$perm, 3 and $hdr1.="<th>Extra" and $colspec.="<colgroup span=1>";                  ##Extra hack
 277
 278      for my $task (@tasks) {
 279         push @$perm, $p++;
 280         $hdr1 .= "<th>$task";
 281      }
 282      $hdr1 .= "<th>Total";
 283      $colspec .= "<colgroup span='" . scalar (@tasks) . "'>";
 284    }
 285
 286    push @$perm, $p++;
 287
 288    print "<TABLE rules=groups frame=all border='1' cellpadding='2'>\n";
 289    print "$colspec<colgroup span='1'>\n";
 290    print "<tr>$hdr1</tr>\n";
 291    print "<tr>$hdr2</tr>\n" if $detail;
 292
 293 }