]>
Commit | Line | Data |
---|---|---|
1 | #!/usr/bin/perl -w | |
2 | use v5.14; | |
3 | ||
4 | use Gruntmaster::Data; | |
5 | ||
6 | use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; | |
7 | use File::Slurp qw/read_file/; | |
8 | use JSON qw/encode_json/; | |
9 | use Term::ANSIColor qw/RED RESET/; | |
10 | use Getopt::Long qw/:config require_order/; | |
11 | ||
12 | ################################################## | |
13 | ||
14 | my $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; | |
15 | my $db = Gruntmaster::Data->connect($dsn); | |
16 | ||
17 | sub cmd_help{ | |
18 | exec perldoc => $0 | |
19 | } | |
20 | ||
21 | sub cmd_add{ | |
22 | my $id = shift; | |
23 | my $name = prompt 'Problem name'; | |
24 | my $private = prompt('Private?', '-yn') eq 'y'; | |
25 | my $contest = prompt 'Contest'; | |
26 | my $author = prompt 'Problem author (full name)'; | |
27 | my $writer = prompt 'Problem statement writer (full name)'; | |
28 | my $owner = prompt 'Problem owner (username)'; | |
29 | my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard"; | |
30 | my $statement = read_file prompt 'File with problem statement', -complete => 'filenames'; | |
31 | my $generator = prompt 'Generator', -menu => "File\nRun\nUndef"; | |
32 | my $runner = prompt 'Runner', -menu => "File\nVerifier\nInteractive"; | |
33 | my $judge = prompt 'Judge', -menu => "Absolute\nPoints"; | |
34 | my $testcnt = prompt 'Test count', '-i'; | |
35 | ||
36 | my $timeout = prompt 'Time limit (seconds)', '-n'; | |
37 | my $olimit = prompt 'Output limit (bytes)', '-i'; | |
38 | say 'Memory limits are broken, so I won\'t ask you for one'; | |
39 | ||
40 | my (@tests, $gensource, $genformat, $versource, $verformat); | |
41 | ||
42 | if ($generator eq 'Run') { | |
43 | $gensource = read_file prompt, '[Generator::Run] Generator file name', -complete => 'filenames'; | |
44 | $genformat = prompt '[Generator::Run] Generator format', -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; | |
45 | } | |
46 | ||
47 | if ($runner eq 'File') { | |
48 | my $default = $judge eq 'Points' ? 10 : 'Ok'; | |
49 | $tests[$_ - 1] = prompt "[Runner::File] Score for test ${_} [$default]", -default => $default for 1 .. $testcnt; | |
50 | } | |
51 | ||
52 | if ($runner eq 'Verifier' || $runner eq 'Interactive') { | |
53 | say RED, 'WARNING: Runner::Interactive is experimental', RESET if $runner eq 'Interactive'; | |
54 | $versource = prompt "[Runner::$runner] Verifier file name", -complete => 'filenames'; | |
55 | $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; | |
56 | } | |
57 | ||
58 | my %options = ( | |
59 | id => $id, | |
60 | name => $name, | |
61 | level => $level, | |
62 | statement => $statement, | |
63 | author => $author, | |
64 | writer => $writer, | |
65 | owner => $owner, | |
66 | generator => $generator, | |
67 | runner => $runner, | |
68 | judge => $judge, | |
69 | testcnt => $testcnt, | |
70 | ); | |
71 | $options{private} = $private if $private; | |
72 | $options{timeout} = $timeout if $timeout; | |
73 | $options{olimit} = $olimit if $olimit; | |
74 | $options{tests} = encode_json \@tests if @tests; | |
75 | $options{gensource} = $gensource if $gensource; | |
76 | $options{genformat} = $genformat if $genformat; | |
77 | $options{versource} = $versource if $versource; | |
78 | $options{verformat} = $verformat if $verformat; | |
79 | $db->problems->create (\%options); | |
80 | ||
81 | $db->contest_problems->create({problem => $id, contest => $contest}) if $contest; | |
82 | } | |
83 | ||
84 | sub cmd_set{ | |
85 | my $file; | |
86 | GetOptions ( 'file!' => \$file ); | |
87 | my ($id, %values) = @_; | |
88 | %values = map { $_ => scalar read_file $values{$_} } keys %values if $file; | |
89 | $db->problem($id)->update(\%values) | |
90 | } | |
91 | ||
92 | sub cmd_get{ | |
93 | my ($id, $col) = @_; | |
94 | say $db->problem($id)->get_column($col) | |
95 | } | |
96 | ||
97 | sub cmd_list{ | |
98 | local $, = "\n"; | |
99 | say map {$_->id} $db->problems->all | |
100 | } | |
101 | ||
102 | sub cmd_rm{ | |
103 | $db->problem(shift)->delete | |
104 | } | |
105 | ||
106 | sub cmd_show{ | |
107 | my %columns = $db->problem(shift)->get_columns; | |
108 | print <<END | |
109 | Name: $columns{name} | |
110 | Author: $columns{author} | |
111 | Statement written by: $columns{writer} | |
112 | Owner: $columns{owner} | |
113 | Level: $columns{level} | |
114 | Output limit: $columns{olimit} | |
115 | Time limit: $columns{timeout} | |
116 | Test count: $columns{testcnt} | |
117 | Generator: $columns{generator} | |
118 | Runner: $columns{runner} | |
119 | Judge: $columns{judge} | |
120 | Private: $columns{private} | |
121 | END | |
122 | } | |
123 | ||
124 | ################################################## | |
125 | ||
126 | my $cmd = 'cmd_' . shift; | |
127 | cmd_help unless exists $main::{$cmd}; | |
128 | no strict 'refs'; | |
129 | $cmd->(@ARGV); | |
130 | ||
131 | 1; | |
132 | __END__ | |
133 | ||
134 | =encoding utf-8 | |
135 | ||
136 | =head1 NAME | |
137 | ||
138 | gruntmaster-problem - shell interface to Gruntmaster 6000 problems | |
139 | ||
140 | =head1 SYNOPSIS | |
141 | ||
142 | gruntmaster-problem add problem_id | |
143 | gruntmaster-problem list | |
144 | gruntmaster-problem rm problem_id | |
145 | gruntmaster-problem show problem_id | |
146 | gruntmaster-problem set [--file] problem_id key value | |
147 | gruntmaster-problem get problem_id key | |
148 | ||
149 | =head1 DESCRIPTION | |
150 | ||
151 | gruntmaster-problem is a tool for managing problems. | |
152 | ||
153 | =over | |
154 | ||
155 | =item B<list> | |
156 | ||
157 | Prints the list of problems in the selected contest. | |
158 | ||
159 | =item B<show> I<id> | |
160 | ||
161 | Prints detailed information about problem I<id>. | |
162 | ||
163 | =item B<add> I<id> | |
164 | ||
165 | Adds a new problem with id I<id>. | |
166 | ||
167 | =item B<rm> I<id> | |
168 | ||
169 | Removes the problem with id I<id>. | |
170 | ||
171 | =item B<set> I<id> I<key> I<value> | |
172 | ||
173 | Sets the I<key> configuration option of problem I<id> to I<value>. | |
174 | ||
175 | =item B<get> I<id> I<key> | |
176 | ||
177 | Get the value of the I<key> configuration option of problem I<id> | |
178 | ||
179 | =item B<set> --file I<id> I<key> I<file> | |
180 | ||
181 | Sets the I<key> configuration option of problem I<id> to the contents of the file I<file>. | |
182 | ||
183 | =back | |
184 | ||
185 | =head1 AUTHOR | |
186 | ||
187 | Marius Gavrilescu E<lt>marius@ieval.roE<gt> | |
188 | ||
189 | =head1 COPYRIGHT AND LICENSE | |
190 | ||
191 | Copyright (C) 2014 by Marius Gavrilescu | |
192 | ||
193 | This library is free software; you can redistribute it and/or modify | |
194 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
195 | at your option, any later version of Perl 5 you may have available. | |
196 | ||
197 | ||
198 | =cut |