Improve gruntmaster tools

[gruntmaster-data.git] / gruntmaster-contest

#!/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 $db = Gruntmaster::Data->connect('dbi:Pg:');

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 <<END
Name: $columns{name}
Owner: $columns{owner}
Start: $columns{start}
Stop: $columns{stop}
END
}

sub cmd_add{
	my $id = shift;
	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->contests->create({id => $id, name => $name, owner => $owner, start => $start, stop => $stop})
}

sub cmd_rm{
	$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<list>

Prints the list of contests.

=item B<show> I<id>

Prints detailed information about the contest with id I<id>.

=item B<add> I<id>

Adds a new contest with id I<id>.

=item B<rm> I<id>

Removes the contest with id I<id>.

=item B<set> I<id> I<key> I<value>

Sets the I<key> configuration option of contest I<id> to I<value>.

=item B<get> I<id> I<key>

Get the value of the I<key> configuration option of contest I<id>.

=back

=head1 AUTHOR

Marius Gavrilescu E<lt>marius@ieval.roE<gt>

=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