]> iEval git - gruntmaster-data.git/blobdiff - gruntmaster-problem
Make gruntmaster-problem check also set/clear time limit overrides
[gruntmaster-data.git] / gruntmaster-problem
index 1b240e0c4b3772973ac5d53f66d140b4bf961acd..e74449b61731fdd35b7bec51707e9d121f5b59ee 100755 (executable)
@@ -3,15 +3,26 @@ use v5.14;
 
 use Gruntmaster::Data;
 
+use File::Temp qw/tempfile/;
+
 use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
-use File::Slurp qw/read_file/;
-use JSON qw/encode_json/;
+use File::Slurp qw/read_file write_file/;
+use JSON qw/decode_json encode_json/;
+use List::Util qw/max min/;
 use Term::ANSIColor qw/RED RESET/;
 use Getopt::Long qw/:config require_order/;
 
+use constant LEVEL_VALUES => {
+       beginner => 100,
+       easy => 250,
+       medium => 500,
+       hard => 1000,
+};
+
 ##################################################
 
-my $db = Gruntmaster::Data->connect('dbi:Pg:');
+my $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:';
+my $db = Gruntmaster::Data->connect($dsn);
 
 sub cmd_help{
        exec perldoc => $0
@@ -23,8 +34,10 @@ sub cmd_add{
        my $private = prompt('Private?', '-yn') eq 'y';
        my $contest = prompt 'Contest';
        my $author = prompt 'Problem author (full name)';
+       my $writer = prompt 'Problem statement writer (full name)';
        my $owner = prompt 'Problem owner (username)';
        my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard";
+       my $value = LEVEL_VALUES->{$level};
        my $statement = read_file prompt 'File with problem statement', -complete => 'filenames';
        my $generator = prompt 'Generator', -menu => "File\nRun\nUndef";
        my $runner = prompt 'Runner', -menu => "File\nVerifier\nInteractive";
@@ -53,30 +66,31 @@ sub cmd_add{
                $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/];
        }
 
-       $db->problems->create ({
+       my %options = (
                id => $id,
                name => $name,
                level => $level,
+               value => $value,
                statement => $statement,
                author => $author,
+               writer => $writer,
                owner => $owner,
                generator => $generator,
                runner => $runner,
                judge => $judge,
                testcnt => $testcnt,
-               (private => $private)x!! $private,
-               (timeout => $timeout)x!! $timeout,
-               (olimit => $olimit)x!! $olimit,
-               (tests => encode_json \@tests)x!! @tests,
-               (gensource => $gensource)x!! $gensource,
-               (genformat => $genformat)x!! $genformat,
-               (versource => $versource)x!! $versource,
-               (verformat => $verformat)x!! $verformat,
-       });
+       );
+       $options{private} = $private if $private;
+       $options{timeout} = $timeout if $timeout;
+       $options{olimit} = $olimit if $olimit;
+       $options{tests} = encode_json \@tests if @tests;
+       $options{gensource} = $gensource if $gensource;
+       $options{genformat} = $genformat if $genformat;
+       $options{versource} = $versource if $versource;
+       $options{verformat} = $verformat if $verformat;
+       $db->problems->create (\%options);
 
        $db->contest_problems->create({problem => $id, contest => $contest}) if $contest;
-       #PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
-       #PUBLISH genpage => $contest ? "ct/$contest/pb/$id.html" : "pb/$id.html";
 }
 
 sub cmd_set{
@@ -85,31 +99,99 @@ sub cmd_set{
        my ($id, %values) = @ARGV;
        %values = map { $_ => scalar read_file $values{$_} } keys %values if $file;
        $db->problem($id)->update(\%values);
-       #PUBLISH genpage => 'pb/index.html';
-       #PUBLISH genpage => "pb/$id.html";
 }
 
 sub cmd_get{
-       my ($id, $col) = @ARGV;
+       my ($id, $col) = @_;
        say $db->problem($id)->get_column($col)
 }
 
+sub cmd_edit{
+       my ($id, $col) = @_;
+       my ($fh, $file) = tempfile 'gruntmaster-problem-editXXXX', TMPDIR => 1, UNLINK => 1;
+       write_file $fh, $db->problem($id)->get_column($col);
+       close $fh;
+       my $editor = $ENV{EDITOR} // 'editor';
+       system $editor, $file;
+       $db->problem($id)->update({$col => scalar read_file $file}) or die "$!";
+}
+
 sub cmd_list{
        local $, = "\n";
-       say map {$_->id} $db->problems->all;
+       say map {$_->id} $db->problems->all
 }
 
 sub cmd_rm{
-       $db->problem(shift)->delete;
-       #PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
+       my ($id) = @_;
+       $db->problem($id)->delete;
 }
 
 sub cmd_show{
-       local $_ = shift or goto &cmd_list;
+       my %columns = $db->problem(shift)->get_columns;
+       print <<END
+Name: $columns{name}
+Author: $columns{author}
+Statement written by: $columns{writer}
+Owner: $columns{owner}
+Level: $columns{level}
+Output limit: $columns{olimit}
+Time limit: $columns{timeout}
+Test count: $columns{testcnt}
+Generator: $columns{generator}
+Runner: $columns{runner}
+Judge: $columns{judge}
+Private: $columns{private}
+END
+}
+
+sub cmd_check {
+       my ($set, $clear);
+       GetOptions ( 'set|s' => \$set, 'clear|c' => \$clear );
+       my ($id) = @ARGV;
+       my @jobs = $db->jobs->search({problem => $id, reference => { '!=', undef }})->all;
+       say 'Rerunning ' . @jobs . ' reference jobs...';
+       $_->rerun for @jobs;
+       sleep 1 while $db->jobs->search({problem => $id, result_text => undef})->count;
+
+       my (%pass, %fail, $fail);
+
+       for (@jobs) {
+               $_->discard_changes;
+               my $time = max map { $_->{time} } @{decode_json $_->results};
+               $pass{$_->format} = max ($pass{$_->format} // (), $time) if $_->reference == 0;
+               $fail{$_->format} = max ($fail{$_->format} // (), $time) if $_->reference == 3;
+               if ($_->result == $_->reference) {
+                       say 'Job ' . $_->id . ' OK'
+               } else {
+                       say 'Job ' . $_->id . ' got ' . $_->result . ' instead of ' . $_->reference;
+                       $fail = 1;
+               }
+       }
+
+       printf "Min timeout for %s: %.2fs\n", $_, $pass{$_} for keys %pass;
+       printf "Max timeout for %s: %.2fs\n", $_, $fail{$_} for keys %fail;
+       say $fail ? 'Test failed' : 'Test successful';
+
+       if ($clear) {
+               $db->limits->search({problem => $id})->delete;
+               say 'Cleared time limits';
+       }
+
+       if ($set) {
+               for (keys %pass) {
+                       my $time = $pass{$_};
+                       $time = sprintf '%.1f', $time * 3/2 + 0.1;
+                       $db->limits->create({problem => $id, format => $_, timeout => $time});
+                       say "Set time limit for $_ to $time";
+               }
+       }
+
+       exit $fail if $fail;
 }
 
 ##################################################
 
+Getopt::Long::Configure 'bundling';
 my $cmd = 'cmd_' . shift;
 cmd_help unless exists $main::{$cmd};
 no strict 'refs';
@@ -132,13 +214,13 @@ gruntmaster-problem - shell interface to Gruntmaster 6000 problems
   gruntmaster-problem show problem_id
   gruntmaster-problem set [--file] problem_id key value
   gruntmaster-problem get problem_id key
+  gruntmaster-problem edit problem_id key
+  gruntmaster-problem check [-cs] [--clear] [--set] problem_id
 
 =head1 DESCRIPTION
 
 gruntmaster-problem is a tool for managing problems.
 
-Select the contest with the optional argument I<--contest>.
-
 =over
 
 =item B<list>
@@ -165,10 +247,22 @@ Sets the I<key> configuration option of problem I<id> to I<value>.
 
 Get the value of the I<key> configuration option of problem I<id>
 
+=item B<edit> I<id> I<key>
+
+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.
+
 =item B<set> --file I<id> I<key> I<file>
 
 Sets the I<key> configuration option of problem I<id> to the contents of the file I<file>.
 
+=item B<check> [args] I<id>
+
+Rerun all reference jobs for problem I<id> and check their results.
+
+With the I<--clear> or I<-c> argument, removes all time limit overrides for this problem.
+
+With the I<--set> or I<-s> argument, automatically adds time limit overrides based on the times used by the reference solutions.
+
 =back
 
 =head1 AUTHOR
@@ -179,10 +273,9 @@ Marius Gavrilescu E<lt>marius@ieval.roE<gt>
 
 Copyright (C) 2014 by Marius Gavrilescu
 
-This library is free software: you can redistribute it and/or modify
-it under the terms of the GNU Affero General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+This library is free software; you can redistribute it and/or modify
+it under the same terms as Perl itself, either Perl version 5.18.1 or,
+at your option, any later version of Perl 5 you may have available.
 
 
 =cut
This page took 0.032414 seconds and 4 git commands to generate.