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 $usage = "Usage: mo-score [--detail] [--alt] [--extras] [--html] [--tex] <task1> <task2> ...";
  10 while (($arg = $ARGV[0]) =~ /^--([a-z]+)$/) {
  11         shift @ARGV;
  12         $var = "\$$1";
  13         if (!eval "defined $var") { die $usage; }
  14         eval "$var = 1;";
  15 }
  16 @ARGV || die $usage;
  17
  18 print STDERR "Scanning contestants... ";
  19 open (CT, "bin/mo-get-users --full |") || die "Cannot get list of contestants";
  20 while (<CT>) {
  21         chomp;
  22         ($u,$f) = split /\t/;
  23         ($u eq "somebody") && next;
  24         $users{$u}=$f;
  25 }
  26 close CT;
  27 print STDERR 0+keys %users, "\n";
  28
  29 print STDERR "Scanning exceptions... ";
  30 if ($extras && open (EX, "exceptions")) {
  31         while (<EX>) {
  32                 chomp;
  33                 (/^$/ || /^#/) && next;
  34                 @a = split /\s+/;
  35                 $u = shift @a;
  36                 defined $users{$u} || die "Unknown user $u";
  37                 while (@a) { $extra{$u} += shift @a; }
  38         }
  39         close EX;
  40         print STDERR "OK\n";
  41 } else { print STDERR "none\n"; }
  42
  43 print STDERR "Scanning task results... ";
  44 $need_tasks = join("|", @ARGV);
  45 %messages = ();
  46 %error_codes = ();
  47 foreach $u (keys %users) {
  48         opendir (D, "testing/$u") or next;
  49         foreach $t (readdir(D)) {
  50                 $t =~ /^\./ && next;
  51                 $t =~ /$need_tasks/ || next;
  52                 $known_tasks{$t} = 1;
  53                 $tt = "testing/$u/$t/points" . ($alt ? ".alt" : "");
  54                 -f $tt || next;
  55                 print STDERR "$u/$t ";
  56                 open (X, $tt) || die "Unable to open $tt";
  57                 while (<X>) {
  58                         chomp;
  59                         /^(\S+) (-?\d+)\s*(.*)/ || die "Parse error: $_";
  60                         $ttest = $1;
  61                         $tpts = $2;
  62                         $trem = $3;
  63                         $ttest =~ s/[^0-9]//g;
  64                         $known_tests{$t}{$ttest} = 1;
  65                         $results{$u}{$t}{$ttest} = $tpts;
  66                         $remarks{$u}{$t}{$ttest} = $trem;
  67                         $cmt = $tpts;
  68                         if ($tpts == 0) {
  69                                 if ($trem =~ /^Compile /) { $cmt = "CE"; }
  70                                 elsif ($trem =~ /^Time limit exceeded/) { $cmt = "TO"; }
  71                                 elsif ($trem =~ /^Exited with error /) { $cmt = "RE"; }
  72                                 elsif ($trem =~ /^Caught fatal signal /) { $cmt = "SG"; }
  73                                 elsif ($trem =~ /^([A-Za-z])\S*\s+([A-Za-z])/) {
  74                                         ($cmt = "$1$2") =~ tr/a-z/A-Z/;
  75                                 }
  76                                 elsif ($trem =~ /^Wrong answer/) { $cmt = "WA"; }
  77                                 if (!defined $messages{$trem}) {
  78                                         $messages{$trem} = $cmt;
  79                                         if (!defined $error_codes{$cmt}) {
  80                                                 $error_codes{$cmt} = $trem;
  81                                         } else {
  82                                                 $error_codes{$cmt} .= ", $trem";
  83                                         }
  84                                 }
  85                         }
  86                         $comment{$u}{$t}{$ttest} = $cmt;
  87                         $total{$u}{$t} += $tpts;
  88                 }
  89                 close X;
  90         }
  91         closedir D;
  92 }
  93 print STDERR "OK\n";
  94
  95 print STDERR "Creating table template... ";
  96 @header = ("Rank","User","Name");
  97 @body = ('','$u','$users{$u}');
  98 @bodysums = ();
  99 @footer = ('"Total"','','');
 100 if (keys %extra) {
 101         push @header, "Extra";
 102         push @body, '$extra{$u}';
 103         $col = 0+@footer;
 104         push @bodysums, $col;
 105         push @footer, "sum($col)";
 106 }
 107 foreach $t (@ARGV) {
 108         defined $known_tasks{$t} || die "Unknown task $t";
 109         push @header, substr($t, 0, 4);
 110         push @body, "(\$xx = \$total{\$u}{'$t'}) > 0 ? \$xx : 0";
 111         $col = 0+@footer;
 112         push @footer, "sum($col)";
 113         push @bodysums, $col;
 114         if ($detail) {
 115                 foreach $s (sort { $a <=> $b } keys %{$known_tests{$t}}) {
 116                         push @header, "$s";
 117                         push @body, "\$comment{\$u}{'$t'}{'$s'}";
 118                         $col = 0+@footer;
 119                         push @footer, "sum($col)";
 120                 }
 121         }
 122 }
 123 push @header, "Total";
 124 push @body, join('+', map { $_ = "\$$_" } @bodysums);
 125 $col = 0+@footer;
 126 push @footer, "sum($col)";
 127 print STDERR "OK\n";
 128
 129 print STDERR "h: ", join(':',@header), "\n" if $debug;
 130 print STDERR "b: ", join(':',@body), "\n" if $debug;
 131 print STDERR "f: ", join(':',@footer), "\n" if $debug;
 132
 133 print STDERR "Filling in results... ";
 134 @table = ();
 135 foreach $u (keys %users) {
 136         $row = [];
 137         foreach my $c (@body) {
 138                 $c =~ s/\$(\d+)/\$\$row[$1]/g;
 139                 $x = eval $c;
 140                 push @$row, (defined $x ? $x : '-');
 141         }
 142         print STDERR "row: ", join(':',@$row), "\n" if $debug;
 143         push @table, $row;
 144 }
 145 print STDERR "OK\n";
 146
 147 print STDERR "Sorting... ";
 148 $sortcol = @{$table[0]} - 1;
 149 $namecol = 2;
 150 @table = sort {
 151         my $p, $an, $bn;
 152         $p = $$b[$sortcol] <=> $$a[$sortcol];
 153         ($an = $$a[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
 154         ($bn = $$b[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
 155         $p ? $p : ($an cmp $bn);
 156 } @table;
 157 $i=0;
 158 while ($i < @table) {
 159         $j = $i;
 160         while ($i < @table && ${$table[$i]}[$sortcol] == ${$table[$j]}[$sortcol]) {
 161                 $i++;
 162         }
 163         if ($i == $j+1) {
 164                 ${table[$j]}[0] = "$i.";
 165         } else {
 166                 ${table[$j]}[0] = $j+1 . ".-" . $i . ".";
 167                 $j++;
 168                 while ($j < $i) { ${table[$j++]}[0] = ""; };
 169         }
 170 }
 171 print STDERR "OK\n";
 172
 173 print STDERR "Attaching headers and footers... ";
 174 sub sum { my $col=shift @_; my $t=0; foreach my $z (0..@table-1) { $t += ${$table[$z]}[$col]; } $t; }
 175 map { $_ = eval $_; } @footer;
 176 push @table, \@footer;
 177 unshift @table, \@header;
 178 print STDERR "OK\n";
 179
 180 if ($debug) {
 181         foreach $r (@table) { print join(':',@$r), "\n"; }
 182 } elsif ($html) {
 183         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">', "\n";
 184         print "<HTML><HEAD><TITLE>Rank list</TITLE></HEAD><BODY>\n";
 185         print "<H1>Rank list</H1>\n";
 186         print "<TABLE>\n";
 187         $hdr = 1;
 188         foreach $r (@table) {
 189                 print "<TR>", join('',map {
 190                         if ($hdr) { $_ = "<TH>$_"; }
 191                         else { $_ = "<TD align=" . (/^[0-9A-Z-]+$/ ? "right" : "left") . (length($_) > 14 ? " width=150" : "") . ">$_"; }
 192                 } @$r), "\n";
 193                 $hdr = 0;
 194         }
 195         print "</TABLE>\n";
 196         if ($detail) {
 197                 print "<H2>Error codes</H2><UL>\n";
 198                 foreach $r (sort keys %error_codes) { print "<LI>$r: $error_codes{$r}\n"; }
 199                 print "</UL>\n";
 200         }
 201         print "</BODY></HTML>\n";
 202 } elsif ($tex) {
 203         print "\\error{TeX output not supported yet!}\n";
 204 } else {
 205         foreach $r (@table) { print join("\t",@$r), "\n"; }
 206         print "\n";
 207         foreach $r (sort keys %error_codes) { print "$r: $error_codes{$r}\n"; }
 208 }