]>
Commit | Line | Data |
---|---|---|
92f74061 MG |
1 | package Gruntmaster::App::Command::Set; |
2 | ||
3 | use 5.014000; | |
4 | use warnings; | |
5 | ||
b35cbc0d | 6 | our $VERSION = '5999.000_016'; |
92f74061 MG |
7 | |
8 | use Gruntmaster::App '-command'; | |
9 | use Gruntmaster::Data; | |
10 | ||
11 | use File::Slurp qw/read_file/; | |
12 | ||
8ab124f5 MG |
13 | use constant PAGES => { |
14 | contests => '/ct/', | |
15 | jobs => '/log/', | |
16 | problems => '/pb/', | |
17 | users => '/us/', | |
18 | }; | |
19 | ||
92f74061 | 20 | sub opt_spec { |
dcf7f640 | 21 | ['file!', 'Use the contents of a file as value'] |
92f74061 MG |
22 | } |
23 | ||
24 | sub usage_desc { "%c [-cjpu] set id column value [column value ...]\n%c [-cjpu] set --file id column filename [column filename ...]" } | |
25 | ||
26 | sub validate_args { | |
27 | my ($self, $opt, $args) = @_; | |
28 | my @args = @$args; | |
29 | $self->usage_error('No table selected') unless $self->app->table; | |
30 | $self->usage_error('Not enough arguments provided') if @args < 3; | |
31 | $self->usage_error('The number of arguments must be odd') unless @args % 2; | |
32 | } | |
33 | ||
34 | sub execute { | |
35 | my ($self, $opt, $args) = @_; | |
36 | my ($id, %values) = @$args; | |
37 | %values = map { $_ => scalar read_file $values{$_} } keys %values if $opt->{file}; | |
38 | db->update($self->app->table, \%values, {id => $id}); | |
8ab124f5 | 39 | purge PAGES->{$self->app->table}.$_ for '', $id; |
92f74061 MG |
40 | } |
41 | ||
42 | 1; | |
43 | __END__ | |
63afa40a MG |
44 | |
45 | =encoding utf-8 | |
46 | ||
47 | =head1 NAME | |
48 | ||
49 | Gruntmaster::App::Command::Set - set a property of an object | |
50 | ||
51 | =head1 SYNOPSIS | |
52 | ||
53 | gm -u set MGV name 'Marius Gavrilescu' | |
54 | gm -p set aplusb level beginner | |
55 | gm -c set test_ct 'This is a <b>test</b> contest.<br>Nothing to see here' | |
56 | gm -j set 100 result_text Accepted | |
57 | ||
58 | =head1 DESCRIPTION | |
59 | ||
60 | The set command takes three arguments: an object id, a property name, | |
61 | and a value. It sets the given property of the given object to the | |
62 | given value. | |
63 | ||
64 | =head1 SEE ALSO | |
65 | ||
66 | L<gm> | |
67 | ||
68 | =head1 AUTHOR | |
69 | ||
70 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
71 | ||
72 | =head1 COPYRIGHT AND LICENSE | |
73 | ||
b35cbc0d | 74 | Copyright (C) 2014-2016 by Marius Gavrilescu |
63afa40a MG |
75 | |
76 | This library is free software; you can redistribute it and/or modify | |
77 | it under the same terms as Perl itself, either Perl version 5.20.1 or, | |
78 | at your option, any later version of Perl 5 you may have available. | |
79 | ||
80 | ||
81 | =cut |