bin/mo-score

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