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