]>
Commit | Line | Data |
---|---|---|
014ee8a6 MG |
1 | #!/usr/bin/perl -w |
2 | use v5.14; | |
3 | ||
4 | use Gruntmaster::Data; | |
014ee8a6 | 5 | |
ca77adce MG |
6 | use File::Temp qw/tempfile/; |
7 | ||
014ee8a6 | 8 | use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; |
ca77adce | 9 | use File::Slurp qw/read_file write_file/; |
a8d27955 MG |
10 | use JSON qw/decode_json encode_json/; |
11 | use List::Util qw/max min/; | |
014ee8a6 | 12 | use Term::ANSIColor qw/RED RESET/; |
0d2f8987 | 13 | use Getopt::Long qw/:config require_order/; |
014ee8a6 | 14 | |
aaa9eb7d MG |
15 | use constant LEVEL_VALUES => { |
16 | beginner => 100, | |
17 | easy => 250, | |
18 | medium => 500, | |
19 | hard => 1000, | |
20 | }; | |
21 | ||
014ee8a6 MG |
22 | ################################################## |
23 | ||
30e287c3 MG |
24 | my $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; |
25 | my $db = Gruntmaster::Data->connect($dsn); | |
014ee8a6 MG |
26 | |
27 | sub cmd_help{ | |
28 | exec perldoc => $0 | |
29 | } | |
30 | ||
014ee8a6 MG |
31 | sub cmd_add{ |
32 | my $id = shift; | |
33 | my $name = prompt 'Problem name'; | |
646feed4 | 34 | my $private = prompt('Private?', '-yn') eq 'y'; |
756368d0 | 35 | my $contest = prompt 'Contest'; |
014ee8a6 | 36 | my $author = prompt 'Problem author (full name)'; |
6544497e | 37 | my $writer = prompt 'Problem statement writer (full name)'; |
014ee8a6 MG |
38 | my $owner = prompt 'Problem owner (username)'; |
39 | my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard"; | |
aaa9eb7d | 40 | my $value = LEVEL_VALUES->{$level}; |
014ee8a6 | 41 | my $statement = read_file prompt 'File with problem statement', -complete => 'filenames'; |
cd25d613 MG |
42 | my $generator = prompt 'Generator', -menu => "File\nRun\nUndef"; |
43 | my $runner = prompt 'Runner', -menu => "File\nVerifier\nInteractive"; | |
44 | my $judge = prompt 'Judge', -menu => "Absolute\nPoints"; | |
45 | my $testcnt = prompt 'Test count', '-i'; | |
014ee8a6 | 46 | |
cd25d613 MG |
47 | my $timeout = prompt 'Time limit (seconds)', '-n'; |
48 | my $olimit = prompt 'Output limit (bytes)', '-i'; | |
014ee8a6 MG |
49 | say 'Memory limits are broken, so I won\'t ask you for one'; |
50 | ||
756368d0 | 51 | my (@tests, $gensource, $genformat, $versource, $verformat); |
014ee8a6 | 52 | |
756368d0 MG |
53 | if ($generator eq 'Run') { |
54 | $gensource = read_file prompt, '[Generator::Run] Generator file name', -complete => 'filenames'; | |
55 | $genformat = prompt '[Generator::Run] Generator format', -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; | |
014ee8a6 MG |
56 | } |
57 | ||
756368d0 MG |
58 | if ($runner eq 'File') { |
59 | my $default = $judge eq 'Points' ? 10 : 'Ok'; | |
60 | $tests[$_ - 1] = prompt "[Runner::File] Score for test ${_} [$default]", -default => $default for 1 .. $testcnt; | |
61 | } | |
014ee8a6 | 62 | |
756368d0 MG |
63 | if ($runner eq 'Verifier' || $runner eq 'Interactive') { |
64 | say RED, 'WARNING: Runner::Interactive is experimental', RESET if $runner eq 'Interactive'; | |
65 | $versource = prompt "[Runner::$runner] Verifier file name", -complete => 'filenames'; | |
66 | $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; | |
014ee8a6 MG |
67 | } |
68 | ||
4af36605 | 69 | my %options = ( |
756368d0 | 70 | id => $id, |
646feed4 MG |
71 | name => $name, |
72 | level => $level, | |
aaa9eb7d | 73 | value => $value, |
646feed4 MG |
74 | statement => $statement, |
75 | author => $author, | |
6544497e | 76 | writer => $writer, |
646feed4 MG |
77 | owner => $owner, |
78 | generator => $generator, | |
79 | runner => $runner, | |
80 | judge => $judge, | |
81 | testcnt => $testcnt, | |
4af36605 MG |
82 | ); |
83 | $options{private} = $private if $private; | |
84 | $options{timeout} = $timeout if $timeout; | |
85 | $options{olimit} = $olimit if $olimit; | |
86 | $options{tests} = encode_json \@tests if @tests; | |
87 | $options{gensource} = $gensource if $gensource; | |
88 | $options{genformat} = $genformat if $genformat; | |
89 | $options{versource} = $versource if $versource; | |
90 | $options{verformat} = $verformat if $verformat; | |
91 | $db->problems->create (\%options); | |
756368d0 MG |
92 | |
93 | $db->contest_problems->create({problem => $id, contest => $contest}) if $contest; | |
014ee8a6 MG |
94 | } |
95 | ||
96 | sub cmd_set{ | |
97 | my $file; | |
98 | GetOptions ( 'file!' => \$file ); | |
866602c7 | 99 | my ($id, %values) = @ARGV; |
014ee8a6 | 100 | %values = map { $_ => scalar read_file $values{$_} } keys %values if $file; |
edfc5928 | 101 | $db->problem($id)->update(\%values); |
014ee8a6 MG |
102 | } |
103 | ||
5214523a | 104 | sub cmd_get{ |
4af36605 | 105 | my ($id, $col) = @_; |
5214523a MG |
106 | say $db->problem($id)->get_column($col) |
107 | } | |
108 | ||
ca77adce MG |
109 | sub cmd_edit{ |
110 | my ($id, $col) = @_; | |
111 | my ($fh, $file) = tempfile 'gruntmaster-problem-editXXXX', TMPDIR => 1, UNLINK => 1; | |
112 | write_file $fh, $db->problem($id)->get_column($col); | |
113 | close $fh; | |
114 | my $editor = $ENV{EDITOR} // 'editor'; | |
115 | system $editor, $file; | |
91f4171d | 116 | $db->problem($id)->update({$col => scalar read_file $file}) or die "$!"; |
ca77adce MG |
117 | } |
118 | ||
014ee8a6 MG |
119 | sub cmd_list{ |
120 | local $, = "\n"; | |
4af36605 | 121 | say map {$_->id} $db->problems->all |
014ee8a6 MG |
122 | } |
123 | ||
124 | sub cmd_rm{ | |
edfc5928 MG |
125 | my ($id) = @_; |
126 | $db->problem($id)->delete; | |
014ee8a6 MG |
127 | } |
128 | ||
129 | sub cmd_show{ | |
4af36605 MG |
130 | my %columns = $db->problem(shift)->get_columns; |
131 | print <<END | |
132 | Name: $columns{name} | |
133 | Author: $columns{author} | |
134 | Statement written by: $columns{writer} | |
135 | Owner: $columns{owner} | |
136 | Level: $columns{level} | |
137 | Output limit: $columns{olimit} | |
138 | Time limit: $columns{timeout} | |
139 | Test count: $columns{testcnt} | |
140 | Generator: $columns{generator} | |
141 | Runner: $columns{runner} | |
142 | Judge: $columns{judge} | |
143 | Private: $columns{private} | |
144 | END | |
014ee8a6 MG |
145 | } |
146 | ||
a8d27955 | 147 | sub cmd_check { |
a1da4db7 MG |
148 | my ($set, $clear); |
149 | GetOptions ( 'set|s' => \$set, 'clear|c' => \$clear ); | |
150 | my ($id) = @ARGV; | |
a8d27955 MG |
151 | my @jobs = $db->jobs->search({problem => $id, reference => { '!=', undef }})->all; |
152 | say 'Rerunning ' . @jobs . ' reference jobs...'; | |
153 | $_->rerun for @jobs; | |
154 | sleep 1 while $db->jobs->search({problem => $id, result_text => undef})->count; | |
155 | ||
de599ce6 | 156 | my (%pass, %fail, $fail); |
a8d27955 MG |
157 | |
158 | for (@jobs) { | |
159 | $_->discard_changes; | |
de599ce6 MG |
160 | my $time = max map { $_->{time} } @{decode_json $_->results}; |
161 | $pass{$_->format} = max ($pass{$_->format} // (), $time) if $_->reference == 0; | |
162 | $fail{$_->format} = max ($fail{$_->format} // (), $time) if $_->reference == 3; | |
a8d27955 MG |
163 | if ($_->result == $_->reference) { |
164 | say 'Job ' . $_->id . ' OK' | |
165 | } else { | |
166 | say 'Job ' . $_->id . ' got ' . $_->result . ' instead of ' . $_->reference; | |
167 | $fail = 1; | |
168 | } | |
169 | } | |
170 | ||
de599ce6 MG |
171 | printf "Min timeout for %s: %.2fs\n", $_, $pass{$_} for keys %pass; |
172 | printf "Max timeout for %s: %.2fs\n", $_, $fail{$_} for keys %fail; | |
a8d27955 | 173 | say $fail ? 'Test failed' : 'Test successful'; |
a1da4db7 MG |
174 | |
175 | if ($clear) { | |
176 | $db->limits->search({problem => $id})->delete; | |
177 | say 'Cleared time limits'; | |
178 | } | |
179 | ||
180 | if ($set) { | |
181 | for (keys %pass) { | |
182 | my $time = $pass{$_}; | |
183 | $time = sprintf '%.1f', $time * 3/2 + 0.1; | |
843c9095 | 184 | next if $time eq $db->problem($id)->timeout; |
a1da4db7 MG |
185 | $db->limits->create({problem => $id, format => $_, timeout => $time}); |
186 | say "Set time limit for $_ to $time"; | |
187 | } | |
188 | } | |
189 | ||
1cdb31fc | 190 | exit $fail if $fail; |
a8d27955 MG |
191 | } |
192 | ||
014ee8a6 MG |
193 | ################################################## |
194 | ||
a1da4db7 | 195 | Getopt::Long::Configure 'bundling'; |
014ee8a6 MG |
196 | my $cmd = 'cmd_' . shift; |
197 | cmd_help unless exists $main::{$cmd}; | |
198 | no strict 'refs'; | |
756368d0 | 199 | $cmd->(@ARGV); |
014ee8a6 MG |
200 | |
201 | 1; | |
202 | __END__ | |
203 | ||
204 | =encoding utf-8 | |
205 | ||
206 | =head1 NAME | |
207 | ||
208 | gruntmaster-problem - shell interface to Gruntmaster 6000 problems | |
209 | ||
210 | =head1 SYNOPSIS | |
211 | ||
5214523a MG |
212 | gruntmaster-problem add problem_id |
213 | gruntmaster-problem list | |
214 | gruntmaster-problem rm problem_id | |
215 | gruntmaster-problem show problem_id | |
216 | gruntmaster-problem set [--file] problem_id key value | |
217 | gruntmaster-problem get problem_id key | |
ca77adce | 218 | gruntmaster-problem edit problem_id key |
a1da4db7 | 219 | gruntmaster-problem check [-cs] [--clear] [--set] problem_id |
014ee8a6 MG |
220 | |
221 | =head1 DESCRIPTION | |
222 | ||
e90402be MG |
223 | gruntmaster-problem is a tool for managing problems. |
224 | ||
e90402be MG |
225 | =over |
226 | ||
227 | =item B<list> | |
228 | ||
229 | Prints the list of problems in the selected contest. | |
230 | ||
231 | =item B<show> I<id> | |
232 | ||
233 | Prints detailed information about problem I<id>. | |
234 | ||
235 | =item B<add> I<id> | |
236 | ||
237 | Adds a new problem with id I<id>. | |
238 | ||
239 | =item B<rm> I<id> | |
240 | ||
241 | Removes the problem with id I<id>. | |
242 | ||
243 | =item B<set> I<id> I<key> I<value> | |
244 | ||
245 | Sets the I<key> configuration option of problem I<id> to I<value>. | |
246 | ||
5214523a MG |
247 | =item B<get> I<id> I<key> |
248 | ||
249 | Get the value of the I<key> configuration option of problem I<id> | |
250 | ||
ca77adce MG |
251 | =item B<edit> I<id> I<key> |
252 | ||
253 | Opens an editor with the value of the I<key> configuration option. After the editor exits, the option is updated to the value of the file. | |
254 | ||
e90402be MG |
255 | =item B<set> --file I<id> I<key> I<file> |
256 | ||
257 | Sets the I<key> configuration option of problem I<id> to the contents of the file I<file>. | |
258 | ||
a1da4db7 | 259 | =item B<check> [args] I<id> |
78ee4c0a MG |
260 | |
261 | Rerun all reference jobs for problem I<id> and check their results. | |
262 | ||
a1da4db7 MG |
263 | With the I<--clear> or I<-c> argument, removes all time limit overrides for this problem. |
264 | ||
265 | With the I<--set> or I<-s> argument, automatically adds time limit overrides based on the times used by the reference solutions. | |
266 | ||
e90402be MG |
267 | =back |
268 | ||
269 | =head1 AUTHOR | |
270 | ||
271 | Marius Gavrilescu E<lt>marius@ieval.roE<gt> | |
272 | ||
273 | =head1 COPYRIGHT AND LICENSE | |
274 | ||
275 | Copyright (C) 2014 by Marius Gavrilescu | |
276 | ||
4af36605 MG |
277 | This library is free software; you can redistribute it and/or modify |
278 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
279 | at your option, any later version of Perl 5 you may have available. | |
014ee8a6 MG |
280 | |
281 | ||
282 | =cut |