]> mj.ucw.cz Git - eval.git/blob - mop/eval/mo-score.sh
Merge branch 'container'
[eval.git] / 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                                 } elsif ($trem =~ /^([A-Za-z]{2})/) {
86                                         ($cmt = $1) =~ tr/a-z/A-Z/;
87                                 }
88                                 if (!defined $messages{$trem}) {
89                                         $messages{$trem} = $cmt;
90                                         if (!defined $error_codes{$cmt}) {
91                                                 $error_codes{$cmt} = $trem;
92                                         } else {
93                                                 $error_codes{$cmt} .= ", $trem";
94                                         }
95                                 }
96                         }
97                         if (!defined($results{$u}{$t}{$ttest}) || $results{$u}{$t}{$ttest} > $tpts) {
98                                 $results{$u}{$t}{$ttest} = $tpts;
99                                 $comment{$u}{$t}{$ttest} = $cmt;
100                         }
101                         if (!defined($results_merged{$u}{$t}{$ttest_merged}) || $results_merged{$u}{$t}{$ttest_merged} > $tpts) {
102                                 $results_merged{$u}{$t}{$ttest_merged} = $tpts;
103                         }
104                 }
105                 close X;
106         }
107         foreach my $t (keys %known_tasks) {
108                 $total{$u}{$t} = 0;
109                 foreach my $pts (values %{$results_merged{$u}{$t}}) { $total{$u}{$t} += $pts; }
110         }
111 }
112 print STDERR "OK\n";
113
114 print STDERR "Creating table template... ";
115 @header = ("Rank","User","Name");
116 @body = ('','$u','$users{$u}');
117 @bodysums = ();
118 @footer = ('"Total"','','');
119 if (keys %extra) {
120         push @header, "Extra";
121         push @body, '$extra{$u}';
122         $col = 0+@footer;
123         push @bodysums, $col;
124         push @footer, "sum($col)";
125 }
126 @tasks = ();
127 foreach $task (@ARGV) {
128         my $t = ($task =~ m@/([^/]*)$@) ? $1 : $task;
129         defined $known_tasks{$t} || die "Unknown task $t";
130         push @tasks, $t;
131         push @header, substr($t, 0, 4);
132         push @body, "(\$xx = \$total{\$u}{'$t'}) > 0 ? \$xx : 0";
133         $col = 0+@footer;
134         push @footer, "sum($col)";
135         push @bodysums, $col;
136         if ($detail) {
137                 foreach $s (sort { $a <=> $b } keys %{$known_tests{$t}}) {
138                         push @header, "$s";
139                         push @body, "\$comment{\$u}{'$t'}{'$s'}";
140                         $col = 0+@footer;
141                         push @footer, "sum($col)";
142                 }
143         }
144 }
145 push @header, "Total";
146 push @body, join('+', map { $_ = "\$$_" } @bodysums);
147 $col = 0+@footer;
148 push @footer, "sum($col)";
149 print STDERR "OK\n";
150
151 print STDERR "h: ", join(':',@header), "\n" if $debug;
152 print STDERR "b: ", join(':',@body), "\n" if $debug;
153 print STDERR "f: ", join(':',@footer), "\n" if $debug;
154
155 print STDERR "Filling in results... ";
156 @table = ();
157 foreach $u (keys %users) {
158         $row = [];
159         foreach my $c (@body) {
160                 $c =~ s/\$(\d+)/\$\$row[$1]/g;
161                 $x = eval $c;
162                 push @$row, (defined $x ? $x : '-');
163         }
164         print STDERR "row: ", join(':',@$row), "\n" if $debug;
165         push @table, $row;
166 }
167 print STDERR "OK\n";
168
169 print STDERR "Sorting... ";
170 $sortcol = @{$table[0]} - 1;
171 $namecol = 2;
172 @table = sort {
173         my $p, $an, $bn;
174         $p = $$b[$sortcol] <=> $$a[$sortcol];
175         ($an = $$a[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
176         ($bn = $$b[$namecol]) =~ s/(\S+)\s+(\S+)/$2 $1/;
177         $p ? $p : ($an cmp $bn);
178 } @table;
179 $i=0;
180 while ($i < @table) {
181         $j = $i;
182         while ($i < @table && ${$table[$i]}[$sortcol] == ${$table[$j]}[$sortcol]) {
183                 $i++;
184         }
185         if ($i == $j+1) {
186                 ${table[$j]}[0] = "$i.";
187         } else {
188                 ${table[$j]}[0] = $j+1 . ".-" . $i . ".";
189                 $j++;
190                 while ($j < $i) { ${table[$j++]}[0] = " "; };
191         }
192 }
193 print STDERR "OK\n";
194
195 print STDERR "Attaching headers and footers... ";
196 sub sum { my $col=shift @_; my $t=0; foreach my $z (0..@table-1) { $t += ${$table[$z]}[$col]; } $t; }
197 map { $_ = eval $_; } @footer;
198 push @table, \@footer;
199 unshift @table, \@header;
200 print STDERR "OK\n";
201
202 if ($debug) {
203         foreach $r (@table) { print join(':',@$r), "\n"; }
204 } elsif ($html) {
205         print '<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN" "http://www.w3.org/TR/html40/strict.dtd">', "\n";
206         print "<HTML><HEAD><TITLE>Rank list</TITLE></HEAD><BODY>\n";
207         print "<H1>Rank list</H1>\n";
208
209         my @perm;
210         &printHtmlHeader(\@perm);
211         print "<tbody>";
212
213         foreach $r (@table[1..($#table - 1)]) {
214                 &printHtmlRow(@{$r}[@perm]);
215         }
216
217         print "<tbody>";
218         &printHtmlRow(@{$table[$#table]}[@perm]);
219
220         print "</TABLE>\n";
221         if ($detail) {
222                 print "<H2>Error codes</H2><UL>\n";
223                 foreach $r (sort keys %error_codes) { print "<LI>$r: $error_codes{$r}\n"; }
224                 print "</UL>\n";
225         }
226         print "</BODY></HTML>\n";
227 } elsif ($tex) {
228         print "\\error{TeX output not supported yet!}\n";
229 } else {
230         foreach $r (@table) { print join("\t",@$r), "\n"; }
231         if ($print_key) {
232                 print "\n";
233                 foreach $r (sort keys %error_codes) { print "$r: $error_codes{$r}\n"; }
234         }
235 }
236
237 sub printHtmlRow {
238         print "<TR>", join('',map {
239                 if ($hdr) { $_ = "<TH>$_"; }
240                 else { $_ = "<TD align=" . (/^[0-9A-Z-]+$/ ? "right" : "left") . (length($_) > 14 ? " width=150" : "") . ">$_"; }
241         } @_), "\n";
242 }
243
244 sub printHtmlHeader {
245
246   my ($perm) = @_;
247
248    my $colspec = "<colgroup span=3>";
249    my $hdr1;
250    my $hdr2;
251
252    @$perm = (0, 1, 2);
253    my $p = 3;
254
255    if ($detail) {
256      $hdr1 = "<th rowspan=2>Rank<th rowspan=2>User<th rowspan=2>Name";
257      $extras and $p++ and push @$perm, 3 and $hdr1.="<th rowspan=2>Extra" and $colspec.="<colgroup span=1>";         ##Extra hack
258      for my $task (@tasks) {
259
260         my $nSub = scalar(keys %{$known_tests{$task}});
261
262         $p++;
263         map { push @$perm, $p++ } (1..$nSub);
264         push @$perm, $p - $nSub - 1;
265
266         $colspec .= "<colgroup span='" . $nSub . "'>\n";
267         $colspec .= "<colgroup span='1'>\n";
268         $hdr1 .= "<th colspan='" . ($nSub + 1) . "' style='border-bottom:1px solid black;'>$task";
269         $hdr2 .= join("", map { "<th>$_" } sort {$a <=> $b} keys %{$known_tests{$task}});
270         $hdr2 .= "<th>Total";
271      }
272
273      $hdr1 .= "<th rowspan='2'>Total";
274
275    } else {  ## no detail
276
277      $hdr1 = "<th>Rank<th>User<th>Name";
278      $extras and $p++ and push @$perm, 3 and $hdr1.="<th>Extra" and $colspec.="<colgroup span=1>";                  ##Extra hack
279
280      for my $task (@tasks) {
281         push @$perm, $p++;
282         $hdr1 .= "<th>$task";
283      }
284      $hdr1 .= "<th>Total";
285      $colspec .= "<colgroup span='" . scalar (@tasks) . "'>";
286    }
287
288    push @$perm, $p++;
289
290    print "<TABLE rules=groups frame=all border='1' cellpadding='2'>\n";
291    print "$colspec<colgroup span='1'>\n";
292    print "<tr>$hdr1</tr>\n";
293    print "<tr>$hdr2</tr>\n" if $detail;
294
295 }
296
297 close STDOUT;