From: Marius Gavrilescu Date: Fri, 10 Apr 2015 07:44:10 +0000 (+0300) Subject: Replace gruntmaster-* scripts with App::Cmd-based gm X-Git-Tag: 5999.000_014~31 X-Git-Url: http://git.ieval.ro/?a=commitdiff_plain;h=92f74061ec24c7d45c9312ae54280356530f6c8c;p=gruntmaster-data.git Replace gruntmaster-* scripts with App::Cmd-based gm --- diff --git a/MANIFEST b/MANIFEST index 49bfc98..e5a238d 100644 --- a/MANIFEST +++ b/MANIFEST @@ -1,8 +1,14 @@ Changes db.sql -gruntmaster-contest -gruntmaster-job -gruntmaster-problem +gm +lib/Gruntmaster/App.pm +lib/Gruntmaster/App/Command/Create.pm +lib/Gruntmaster/App/Command/Get.pm +lib/Gruntmaster/App/Command/List.pm +lib/Gruntmaster/App/Command/Rerun.pm +lib/Gruntmaster/App/Command/Rm.pm +lib/Gruntmaster/App/Command/Set.pm +lib/Gruntmaster/App/Command/Show.pm lib/Gruntmaster/Data.pm Makefile.PL make_test_db.sh diff --git a/Makefile.PL b/Makefile.PL index f3fdb45..fa0fa0a 100644 --- a/Makefile.PL +++ b/Makefile.PL @@ -6,7 +6,7 @@ WriteMakefile( VERSION_FROM => 'lib/Gruntmaster/Data.pm', ABSTRACT_FROM => 'lib/Gruntmaster/Data.pm', AUTHOR => 'Marius Gavrilescu ', - EXE_FILES => [qw/gruntmaster-problem gruntmaster-contest gruntmaster-job/], + EXE_FILES => [qw/gm/], MIN_PERL_VERSION => '5.14.0', LICENSE => 'perl', SIGN => 1, @@ -16,6 +16,7 @@ WriteMakefile( POSIX 0 Term::ANSIColor 0 + App::Cmd 0 Date::Parse 0 DBI 0 DBIx::Simple 0 diff --git a/gm b/gm new file mode 100755 index 0000000..bf51ee3 --- /dev/null +++ b/gm @@ -0,0 +1,7 @@ +#!/usr/bin/perl +use v5.14; +use warnings; + +use Gruntmaster::App; + +Gruntmaster::App->run diff --git a/gruntmaster-contest b/gruntmaster-contest deleted file mode 100755 index c6d1db8..0000000 --- a/gruntmaster-contest +++ /dev/null @@ -1,130 +0,0 @@ -#!/usr/bin/perl -w -use v5.14; - -use Gruntmaster::Data; - -use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; -use POSIX qw/strftime/; -use Date::Parse qw/str2time/; - -################################################## - -my $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; -my $db = Gruntmaster::Data->connect($dsn); - -sub cmd_help{ - exec perldoc => $0 -} - -sub cmd_list{ - local $, = "\n"; - say map { $_->id } $db->contests->all; -} - -sub cmd_show{ - my %columns = $db->contest(shift)->get_columns; - $columns{$_} = strftime '%c', localtime $columns{$_} for qw/start stop/; - print <contests->create({id => $id, name => $name, owner => $owner, start => $start, stop => $stop}); -} - -sub cmd_rm{ - my ($id) = @_; - $db->contest(shift)->delete; -} - -sub cmd_get{ - my ($id, $col) = @_; - say $db->contest($id)->get_column($col) -} - -sub cmd_set{ - my ($id, %values) = @_; - $db->contest($id)->update(\%values); -} - -################################################## - -no strict 'refs'; -my $cmd = 'cmd_' . shift; -cmd_help unless exists $main::{$cmd}; -$cmd->(@ARGV) if exists $main::{$cmd}; - -1; -__END__ - -=encoding utf-8 - -=head1 NAME - -gruntmaster-contest - shell interface to Gruntmaster 6000 contests - -=head1 SYNOPSIS - - gruntmaster-contest list - gruntmaster-contest show id - gruntmaster-contest add id - gruntmaster-contest rm id - gruntmaster-contest get id key - gruntmaster-contest set id key value - -=head1 DESCRIPTION - -gruntmaster-contest is a tool for managing contests. - -=over - -=item B - -Prints the list of contests. - -=item B I - -Prints detailed information about the contest with id I. - -=item B I - -Adds a new contest with id I. - -=item B I - -Removes the contest with id I. - -=item B I I I - -Sets the I configuration option of contest I to I. - -=item B I I - -Get the value of the I configuration option of contest I. - -=back - -=head1 AUTHOR - -Marius Gavrilescu Emarius@ieval.roE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2014 by Marius Gavrilescu - -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 diff --git a/gruntmaster-job b/gruntmaster-job deleted file mode 100755 index 0b99cb7..0000000 --- a/gruntmaster-job +++ /dev/null @@ -1,119 +0,0 @@ -#!/usr/bin/perl -w -use v5.14; - -use Gruntmaster::Data; - -use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; -use POSIX qw/strftime/; - -################################################## - -my $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; -my $db = Gruntmaster::Data->connect($dsn); - -sub cmd_help{ - exec perldoc => $0 -} - -sub cmd_show{ - my %columns = $db->job(shift)->get_columns; - $columns{date} = strftime '%c', localtime $columns{date}; - $columns{private} = $columns{private} ? 'yes' : 'no'; - - print <job($id)->delete; -} - -sub cmd_get{ - my ($id, $col) = @_; - say $db->job($id)->get_column($col) -} - -sub cmd_set{ - my ($id, %values) = @_; - $db->job($id)->update(\%values); -} - -sub cmd_rerun{ - my ($id) = @_; - $db->job($id)->rerun; -} - -################################################## - -my $cmd = 'cmd_' . shift; -cmd_help unless exists $main::{$cmd}; -no strict 'refs'; -$cmd->(@ARGV) if exists $main::{$cmd}; - -1; -__END__ - -=encoding utf-8 - -=head1 NAME - -gruntmaster-job - shell interface to Gruntmaster 6000 job log - -=head1 SYNOPSIS - - gruntmaster-job show id - gruntmaster-job rm id - gruntmaster-job get id key - gruntmaster-job set id key value - gruntmaster-job rerun id - -=head1 DESCRIPTION - -gruntmaster-job is a tool for managing jobs. - -=over - -=item B I - -Prints detailed information about the job with id I. - -=item B I - -Removes the job with id I. - -=item B I I I - -Sets the I configuration option of job I to I. - -=item B I I - -Get the value of the I configuration option of job I. - -=item B I - -Reruns job I. - -=back - -=head1 AUTHOR - -Marius Gavrilescu Emarius@ieval.roE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2014 by Marius Gavrilescu - -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 diff --git a/gruntmaster-problem b/gruntmaster-problem deleted file mode 100755 index 0f45fe8..0000000 --- a/gruntmaster-problem +++ /dev/null @@ -1,282 +0,0 @@ -#!/usr/bin/perl -w -use v5.14; - -use Gruntmaster::Data; - -use File::Temp qw/tempfile/; - -use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; -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 $dsn = $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; -my $db = Gruntmaster::Data->connect($dsn); - -sub cmd_help{ - exec perldoc => $0 -} - -sub cmd_add{ - my $id = shift; - my $name = prompt 'Problem name'; - 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"; - my $judge = prompt 'Judge', -menu => "Absolute\nPoints"; - my $testcnt = prompt 'Test count', '-i'; - - my $timeout = prompt 'Time limit (seconds)', '-n'; - my $olimit = prompt 'Output limit (bytes)', '-i'; - say 'Memory limits are broken, so I won\'t ask you for one'; - - my (@tests, $gensource, $genformat, $versource, $verformat); - - if ($generator eq 'Run') { - $gensource = read_file prompt, '[Generator::Run] Generator file name', -complete => 'filenames'; - $genformat = prompt '[Generator::Run] Generator format', -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; - } - - if ($runner eq 'File') { - my $default = $judge eq 'Points' ? 10 : 'Ok'; - $tests[$_ - 1] = prompt "[Runner::File] Score for test ${_} [$default]", -default => $default for 1 .. $testcnt; - } - - if ($runner eq 'Verifier' || $runner eq 'Interactive') { - say RED, 'WARNING: Runner::Interactive is experimental', RESET if $runner eq 'Interactive'; - $versource = prompt "[Runner::$runner] Verifier file name", -complete => 'filenames'; - $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; - } - - 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, - ); - $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; -} - -sub cmd_set{ - my $file; - GetOptions ( 'file!' => \$file ); - my ($id, %values) = @ARGV; - %values = map { $_ => scalar read_file $values{$_} } keys %values if $file; - $db->problem($id)->update(\%values); -} - -sub cmd_get{ - 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 -} - -sub cmd_rm{ - my ($id) = @_; - $db->problem($id)->delete; -} - -sub cmd_show{ - my %columns = $db->problem(shift)->get_columns; - print < \$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; - next if $time eq $db->problem($id)->timeout; - $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'; -$cmd->(@ARGV); - -1; -__END__ - -=encoding utf-8 - -=head1 NAME - -gruntmaster-problem - shell interface to Gruntmaster 6000 problems - -=head1 SYNOPSIS - - gruntmaster-problem add problem_id - gruntmaster-problem list - gruntmaster-problem rm problem_id - 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. - -=over - -=item B - -Prints the list of problems in the selected contest. - -=item B I - -Prints detailed information about problem I. - -=item B I - -Adds a new problem with id I. - -=item B I - -Removes the problem with id I. - -=item B I I I - -Sets the I configuration option of problem I to I. - -=item B I I - -Get the value of the I configuration option of problem I - -=item B I I - -Opens an editor with the value of the I configuration option. After the editor exits, the option is updated to the value of the file. - -=item B --file I I I - -Sets the I configuration option of problem I to the contents of the file I. - -=item B [args] I - -Rerun all reference jobs for problem I 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 - -Marius Gavrilescu Emarius@ieval.roE - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2014 by Marius Gavrilescu - -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 diff --git a/lib/Gruntmaster/App.pm b/lib/Gruntmaster/App.pm new file mode 100644 index 0000000..f61d145 --- /dev/null +++ b/lib/Gruntmaster/App.pm @@ -0,0 +1,43 @@ +package Gruntmaster::App; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use App::Cmd::Setup '-app'; +use Gruntmaster::Data; + +sub allow_any_unambiguous_abbrev () { 1 } +sub default_command { 'commands' } # Show usage when called without arguments + +sub global_opt_spec { + (['table' => 'hidden', {one_of => [ + ['contests|ct|c' => 'Act on contests'], + ['jobs|j' => 'Act on jobs'], + ['problems|pb|p' => 'Act on problems'], + ['users|us|u' => 'Act on users']]}]) +} + +sub table { shift->global_options->{table} } + +Gruntmaster::Data::init $ENV{GRUNTMASTER_DSN} // 'dbi:Pg:'; + +1; +__END__ + +=encoding utf-8 + +=head1 NAME + +Gruntmaster::App - command-line interface to the Gruntmaster 6000 database + +=head1 SYNOPSIS + + + +=head1 DESCRIPTION + + + +=cut diff --git a/lib/Gruntmaster/App/Command/Create.pm b/lib/Gruntmaster/App/Command/Create.pm new file mode 100644 index 0000000..c0d5dfe --- /dev/null +++ b/lib/Gruntmaster/App/Command/Create.pm @@ -0,0 +1,123 @@ +package Gruntmaster::App::Command::Create; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +use Date::Parse qw/str2time/; +use File::Slurp qw/read_file write_file/; +use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ]; +use JSON::MaybeXS qw/encode_json/; +use Term::ANSIColor qw/RED RESET/; + +use constant LEVEL_VALUES => { + beginner => 100, + easy => 250, + medium => 500, + hard => 1000, +}; + +sub usage_desc { '%c [-cp] create id' } + +my %TABLE = ( + contest => \&create_contest, + problem => \&create_problem, +); + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; + $self->usage_error('Don\'t know how to create this object type') unless $TABLE{$self->app->object}; + $self->usage_error('Wrong number of arguments') if @args != 1; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($id) = @$args; + $TABLE{$self->app->object}->($self, $id); +} + +sub create_contest { + my ($self, $id) = @_; + + my $name = prompt 'Contest name'; + my $owner = prompt 'Owner'; + my $start = str2time prompt 'Start time' or die 'Cannot parse time'; + my $stop = str2time prompt 'Stop time' or die 'Cannot parse time'; + + db->insert(contests => {id => $id, name => $name, owner => $owner, start => $start, stop => $stop}); +} + +sub create_problem { + my ($self, $id) = @_; + my $db = $self->app->db; + + my $name = prompt 'Problem name'; + 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"; + my $judge = prompt 'Judge', -menu => "Absolute\nPoints"; + my $testcnt = prompt 'Test count', '-i'; + + my $timeout = prompt 'Time limit (seconds)', '-n'; + my $olimit = prompt 'Output limit (bytes)', '-i'; + say 'Memory limits are broken, so I won\'t ask you for one'; + + my (@tests, $gensource, $genformat, $versource, $verformat); + + if ($generator eq 'Run') { + $gensource = read_file prompt '[Generator::Run] Generator file name', -complete => 'filenames'; + $genformat = prompt '[Generator::Run] Generator format', -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; + } + + if ($runner eq 'File') { + my $default = $judge eq 'Points' ? 10 : 'Ok'; + $tests[$_ - 1] = prompt "[Runner::File] Score for test ${_} [$default]", -default => $default for 1 .. $testcnt; + } + + if ($runner eq 'Verifier' || $runner eq 'Interactive') { + say RED, 'WARNING: Runner::Interactive is experimental', RESET if $runner eq 'Interactive'; + $versource = prompt "[Runner::$runner] Verifier file name", -complete => 'filenames'; + $verformat = prompt "[Runner::$runner] Verifier format", -menu => [qw/C CPP MONO JAVA PASCAL PERL PYTHON/]; + } + + 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, + ); + $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->insert(problems => \%options); + db->insert(contest_problems => {problem => $id, contest => $contest}) if $contest; +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/Get.pm b/lib/Gruntmaster/App/Command/Get.pm new file mode 100644 index 0000000..ab547ad --- /dev/null +++ b/lib/Gruntmaster/App/Command/Get.pm @@ -0,0 +1,27 @@ +package Gruntmaster::App::Command::Get; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +sub usage_desc { '%c [-cjpu] get id column' } + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; + $self->usage_error('Wrong number of arguments') if @args != 2; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($obj, $col) = @$args; + say db->select($self->app->table, $col, {id => $obj})->flat +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/List.pm b/lib/Gruntmaster/App/Command/List.pm new file mode 100644 index 0000000..3c62604 --- /dev/null +++ b/lib/Gruntmaster/App/Command/List.pm @@ -0,0 +1,25 @@ +package Gruntmaster::App::Command::List; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +sub usage_desc { '%c [-cjpu] list' } + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; +} + +sub execute { + my ($self, $opt, $args) = @_; + say join "\n", db->select($self->app->table, 'id', {}, 'id')->flat +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/Rerun.pm b/lib/Gruntmaster/App/Command/Rerun.pm new file mode 100644 index 0000000..b5e98a8 --- /dev/null +++ b/lib/Gruntmaster/App/Command/Rerun.pm @@ -0,0 +1,27 @@ +package Gruntmaster::App::Command::Rerun; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +sub usage_desc { '%c rerun id' } + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('This command only works on jobs') if $self->app->table && $self->app->table ne 'jobs'; + $self->usage_error('Wrong number of arguments') if @args != 1; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($obj) = @$args; + db->rerun_job($obj); +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/Rm.pm b/lib/Gruntmaster/App/Command/Rm.pm new file mode 100644 index 0000000..25dc450 --- /dev/null +++ b/lib/Gruntmaster/App/Command/Rm.pm @@ -0,0 +1,27 @@ +package Gruntmaster::App::Command::Rm; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +sub usage_desc { '%c [-cjpu] rm id' } + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; + $self->usage_error('Wrong number of arguments') if @args != 1; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($obj) = @$args; + say 'Rows deleted: ', db->delete($self->app->table, {id => $obj})->rows +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/Set.pm b/lib/Gruntmaster/App/Command/Set.pm new file mode 100644 index 0000000..b3754dd --- /dev/null +++ b/lib/Gruntmaster/App/Command/Set.pm @@ -0,0 +1,35 @@ +package Gruntmaster::App::Command::Set; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; + +use File::Slurp qw/read_file/; + +sub opt_spec { + ['file!', 'Use the contents of a file as value'], +} + +sub usage_desc { "%c [-cjpu] set id column value [column value ...]\n%c [-cjpu] set --file id column filename [column filename ...]" } + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; + $self->usage_error('Not enough arguments provided') if @args < 3; + $self->usage_error('The number of arguments must be odd') unless @args % 2; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($id, %values) = @$args; + %values = map { $_ => scalar read_file $values{$_} } keys %values if $opt->{file}; + db->update($self->app->table, \%values, {id => $id}); +} + +1; +__END__ diff --git a/lib/Gruntmaster/App/Command/Show.pm b/lib/Gruntmaster/App/Command/Show.pm new file mode 100644 index 0000000..0c06d57 --- /dev/null +++ b/lib/Gruntmaster/App/Command/Show.pm @@ -0,0 +1,69 @@ +package Gruntmaster::App::Command::Show; + +use 5.014000; +use warnings; + +our $VERSION = '5999.000_004'; + +use Gruntmaster::App '-command'; +use Gruntmaster::Data; +use POSIX qw/strftime/; + +sub usage_desc { '%c [-cjpu] show id' } + +my %TABLE = ( + contests => \&show_contest, + jobs => \&show_job, + problems => \&show_problem, + users => \&show_user, +); + +sub validate_args { + my ($self, $opt, $args) = @_; + my @args = @$args; + $self->usage_error('No table selected') unless $self->app->table; + $self->usage_error('Wrong number of arguments') if @args != 1; +} + +sub execute { + my ($self, $opt, $args) = @_; + my ($obj) = @$args; + $TABLE{$self->app->table}->(db->select($self->app->table, '*', {id => $obj})->kv_list); +} + +sub show_contest { + my (%columns) = @_; + $columns{$_} = strftime '%c', localtime $columns{$_} for qw/start stop/; + + print <