]>
Commit | Line | Data |
---|---|---|
be8bda96 | 1 | package Gruntmaster::App::Command::Add; |
92f74061 MG |
2 | |
3 | use 5.014000; | |
4 | use warnings; | |
5 | ||
add75bf5 | 6 | our $VERSION = '5999.000_015'; |
92f74061 MG |
7 | |
8 | use Gruntmaster::App '-command'; | |
9 | use Gruntmaster::Data; | |
10 | ||
11 | use Date::Parse qw/str2time/; | |
12 | use File::Slurp qw/read_file write_file/; | |
13 | use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; | |
14 | use JSON::MaybeXS qw/encode_json/; | |
8bb80034 | 15 | use PerlX::Maybe; |
92f74061 MG |
16 | use Term::ANSIColor qw/RED RESET/; |
17 | ||
18 | use constant LEVEL_VALUES => { | |
19 | beginner => 100, | |
20 | easy => 250, | |
21 | medium => 500, | |
22 | hard => 1000, | |
23 | }; | |
24 | ||
be8bda96 | 25 | sub usage_desc { '%c [-cp] add id' } |
92f74061 MG |
26 | |
27 | my %TABLE = ( | |
5bfe4fee MG |
28 | contests => \&add_contest, |
29 | problems => \&add_problem, | |
92f74061 MG |
30 | ); |
31 | ||
32 | sub validate_args { | |
33 | my ($self, $opt, $args) = @_; | |
34 | my @args = @$args; | |
35 | $self->usage_error('No table selected') unless $self->app->table; | |
5bfe4fee | 36 | $self->usage_error('Don\'t know how to add to this table') unless $TABLE{$self->app->table}; |
92f74061 MG |
37 | $self->usage_error('Wrong number of arguments') if @args != 1; |
38 | } | |
39 | ||
40 | sub execute { | |
41 | my ($self, $opt, $args) = @_; | |
42 | my ($id) = @$args; | |
5bfe4fee | 43 | $TABLE{$self->app->table}->($self, $id); |
92f74061 MG |
44 | } |
45 | ||
be8bda96 | 46 | sub add_contest { |
92f74061 MG |
47 | my ($self, $id) = @_; |
48 | ||
49 | my $name = prompt 'Contest name'; | |
50 | my $owner = prompt 'Owner'; | |
dcf7f640 MG |
51 | my $start = str2time prompt 'Start time' or die "Cannot parse time\n"; |
52 | my $stop = str2time prompt 'Stop time' or die "Cannot parse time\n"; | |
92f74061 MG |
53 | |
54 | db->insert(contests => {id => $id, name => $name, owner => $owner, start => $start, stop => $stop}); | |
7e8f5f0e | 55 | purge '/ct/'; |
92f74061 MG |
56 | } |
57 | ||
be8bda96 | 58 | sub add_problem { |
92f74061 MG |
59 | my ($self, $id) = @_; |
60 | my $db = $self->app->db; | |
61 | ||
62 | my $name = prompt 'Problem name'; | |
63 | my $private = prompt('Private?', '-yn') eq 'y'; | |
64 | my $contest = prompt 'Contest'; | |
65 | my $author = prompt 'Problem author (full name)'; | |
66 | my $writer = prompt 'Problem statement writer (full name)'; | |
67 | my $owner = prompt 'Problem owner (username)'; | |
68 | my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard"; | |
69 | my $value = LEVEL_VALUES->{$level}; | |
70 | my $statement = read_file prompt 'File with problem statement', -complete => 'filenames'; | |
71 | my $generator = prompt 'Generator', -menu => "File\nRun\nUndef"; | |
72 | my $runner = prompt 'Runner', -menu => "File\nVerifier\nInteractive"; | |
73 | my $judge = prompt 'Judge', -menu => "Absolute\nPoints"; | |
74 | my $testcnt = prompt 'Test count', '-i'; | |
75 | ||
76 | my $timeout = prompt 'Time limit (seconds)', '-n'; | |
77 | my $olimit = prompt 'Output limit (bytes)', '-i'; | |
78 | say 'Memory limits are broken, so I won\'t ask you for one'; | |
79 | ||
80 | my (@tests, $gensource, $genformat, $versource, $verformat); | |
81 | ||
82 | if ($generator eq 'Run') { | |
83 | $gensource = read_file prompt '[Generator::Run] Generator file name', -complete => 'filenames'; | |
84 | $genformat = prompt '[Generator::Run] Generator format', -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; | |
85 | } | |
86 | ||
87 | if ($runner eq 'File') { | |
88 | my $default = $judge eq 'Points' ? 10 : 'Ok'; | |
89 | $tests[$_ - 1] = prompt "[Runner::File] Score for test ${_} [$default]", -default => $default for 1 .. $testcnt; | |
90 | } | |
91 | ||
92 | if ($runner eq 'Verifier' || $runner eq 'Interactive') { | |
93 | say RED, 'WARNING: Runner::Interactive is experimental', RESET if $runner eq 'Interactive'; | |
9e2fb099 | 94 | $versource = read_file prompt "[Runner::$runner] Verifier file name", -complete => 'filenames'; |
92f74061 MG |
95 | $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; |
96 | } | |
97 | ||
98 | my %options = ( | |
99 | id => $id, | |
100 | name => $name, | |
101 | level => $level, | |
102 | value => $value, | |
103 | statement => $statement, | |
104 | author => $author, | |
105 | writer => $writer, | |
106 | owner => $owner, | |
107 | generator => $generator, | |
108 | runner => $runner, | |
109 | judge => $judge, | |
110 | testcnt => $testcnt, | |
8bb80034 MG |
111 | maybe private => $private, |
112 | maybe timeout => $timeout, | |
113 | maybe olimit => $olimit, | |
114 | maybe gensource => $gensource, | |
115 | maybe genformat => $genformat, | |
116 | maybe versource => $versource, | |
117 | maybe verformat => $verformat, | |
92f74061 | 118 | ); |
92f74061 | 119 | $options{tests} = encode_json \@tests if @tests; |
92f74061 MG |
120 | db->insert(problems => \%options); |
121 | db->insert(contest_problems => {problem => $id, contest => $contest}) if $contest; | |
7e8f5f0e | 122 | purge '/pb/'; |
92f74061 MG |
123 | } |
124 | ||
125 | 1; | |
126 | __END__ | |
63afa40a MG |
127 | |
128 | =encoding utf-8 | |
129 | ||
130 | =head1 NAME | |
131 | ||
132 | Gruntmaster::App::Command::Add - add a problem or contest by answering a series of prompts | |
133 | ||
134 | =head1 SYNOPSIS | |
135 | ||
136 | gm -p add aplusb | |
137 | gm -c add test_contest | |
138 | ||
139 | =head1 DESCRIPTION | |
140 | ||
141 | The add command creates a new problem or contest by prompting the user | |
142 | for the properties of the new object. It takes a single argument, the | |
143 | ID of the new object. | |
144 | ||
145 | =head1 SEE ALSO | |
146 | ||
147 | L<gm> | |
148 | ||
149 | =head1 AUTHOR | |
150 | ||
151 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
152 | ||
153 | =head1 COPYRIGHT AND LICENSE | |
154 | ||
e1b9f3dd | 155 | Copyright (C) 2014-2015 by Marius Gavrilescu |
63afa40a MG |
156 | |
157 | This library is free software; you can redistribute it and/or modify | |
158 | it under the same terms as Perl itself, either Perl version 5.20.1 or, | |
159 | at your option, any later version of Perl 5 you may have available. | |
160 | ||
161 | ||
162 | =cut |