From 014ee8a614839ded741f61979d979cdd4f20044c Mon Sep 17 00:00:00 2001
From: Marius Gavrilescu <marius@ieval.ro>
Date: Sat, 1 Feb 2014 14:11:36 +0200
Subject: [PATCH] Copy Data.pm and gruntmaster tools from gruntmaster-page

---
 MANIFEST                |   4 +
 gruntmaster-contest     |  73 ++++++++++++++++
 gruntmaster-job         |  72 ++++++++++++++++
 gruntmaster-problem     | 127 ++++++++++++++++++++++++++++
 lib/Gruntmaster/Data.pm | 183 ++++++++++++++++++++++------------------
 5 files changed, 376 insertions(+), 83 deletions(-)
 create mode 100755 gruntmaster-contest
 create mode 100755 gruntmaster-job
 create mode 100755 gruntmaster-problem

diff --git a/MANIFEST b/MANIFEST
index 489150d..37e4261 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -2,5 +2,9 @@ Changes
 Makefile.PL
 MANIFEST
 README
+gruntmaster-contest
+gruntmaster-job
+gruntmaster-problem
 t/Gruntmaster-Data.t
 lib/Gruntmaster/Data.pm
+
diff --git a/gruntmaster-contest b/gruntmaster-contest
new file mode 100755
index 0000000..c2608c9
--- /dev/null
+++ b/gruntmaster-contest
@@ -0,0 +1,73 @@
+#!/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/;
+
+##################################################
+
+sub cmd_help{
+	exec perldoc => $0
+}
+
+sub cmd_list{
+	local $, = "\n";
+	say contests;
+}
+
+sub cmd_show{
+	local $_ = shift or goto &cmd_list;
+	say "Name: ", contest_name;
+	say "Owner: ", contest_owner;
+	say "Start: ", strftime '%c', localtime contest_start;
+	say "End: ", strftime '%c', localtime contest_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 $end = str2time prompt 'End time' or die 'Cannot parse time';
+
+	insert_contest $id => name => $name, owner => $owner, start => $start, end => $end;
+	PUBLISH genpage => "ct/$id/index.html";
+	PUBLISH genpage => "ct/index.html";
+}
+
+sub cmd_rm{
+	remove_contest shift;
+	PUBLISH genpage => "ct/index.html";
+}
+
+##################################################
+
+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
+
+=head1 DESCRIPTION
+
+
+
+=cut
diff --git a/gruntmaster-job b/gruntmaster-job
new file mode 100755
index 0000000..7adab69
--- /dev/null
+++ b/gruntmaster-job
@@ -0,0 +1,72 @@
+#!/usr/bin/perl -w
+use v5.14;
+
+use Gruntmaster::Data;
+
+use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
+use File::Slurp qw/read_file/;
+use Getopt::Long;
+use Term::ANSIColor qw/RED RESET/;
+use POSIX qw/strftime/;
+
+##################################################
+
+my $contest;
+
+sub cmd_help{
+	exec perldoc => $0
+}
+
+sub cmd_card{
+	say jobcard;
+}
+
+sub cmd_show{
+	local $_ = shift or goto &cmd_list;
+	say "Date: " , strftime ('%c', localtime job_date);
+	say "User: ", job_user;
+	say "Problem: ", problem_name job_problem;
+	say "Extension: ", job_extension;
+	say "Size: ", sprintf "%.2fKB", job_filesize() / 1024;
+	say "Private: ", (job_private() ? 'yes' : 'no');
+	say "Result text: ", job_result_text;
+	say "Daemon: ", job_daemon;
+	say "Compile errors: ", job_errors;
+}
+
+sub cmd_rerun{
+	local $_ = shift or goto &cmd_list;
+	clean_job;
+	$contest//='';
+	PUBLISH jobs => "$contest.$_";
+}
+
+##################################################
+
+GetOptions ( 'contest=s' => \$contest );
+local $Gruntmaster::Data::contest = $contest;
+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 card
+  gruntmaster-job show 5
+  gruntmaster-job rerun 7
+
+=head1 DESCRIPTION
+
+
+
+=cut
diff --git a/gruntmaster-problem b/gruntmaster-problem
new file mode 100755
index 0000000..80aa68d
--- /dev/null
+++ b/gruntmaster-problem
@@ -0,0 +1,127 @@
+#!/usr/bin/perl -w
+use v5.14;
+
+use Gruntmaster::Data;
+use Gruntmaster::Page::Submit;
+
+use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
+use File::Slurp qw/read_file/;
+use Term::ANSIColor qw/RED RESET/;
+use Getopt::Long qw/GetOptions/;
+
+##################################################
+
+my $contest;
+
+sub cmd_help{
+	exec perldoc => $0
+}
+
+sub prompt_file{
+	my ($meta, $name, $prefix) = @_;
+	my $filename = prompt '$prefix filename', -complete => 'filenames';
+	$meta->{files}{$name}{content} = read_file $filename;
+	$meta->{files}{$name}{format} = prompt '$prefix format', -menu => Gruntmaster::Page::Submit::FORMATS;
+	$meta->{files}{$name}{name} = prompt "$prefix filename [$filename]", -default => $filename;
+}
+
+sub cmd_add{
+	my $id = shift;
+	my $name = prompt 'Problem name';
+	my $author = prompt 'Problem author (full name)';
+	my $owner = prompt 'Problem owner (username)';
+	my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard";
+	my $statement = read_file prompt 'File with problem statement', -complete => 'filenames';
+	my %meta;
+	$meta{generator} = prompt 'Generator', -menu => "File\nRun\nUndef";
+	$meta{runner} = prompt 'Runner', -menu => "File\nVerifier\nInteractive";
+	$meta{judge} = prompt 'Judge', -menu => "Absolute\nPoints";
+	$meta{testcnt} = prompt 'Test count', '-i';
+
+	$meta{timeout} = prompt 'Time limit (seconds)', '-n';
+	delete $meta{timeout} unless $meta{timeout};
+	$meta{olimit} = prompt 'Output limit (bytes)', '-i';
+	delete $meta{olimit} unless $meta{olimit};
+	say 'Memory limits are broken, so I won\'t ask you for one';
+
+	if ($meta{generator} eq 'File') {
+		my $prefix = prompt '[Generator::File] Input file prefix';
+		$meta{infile}[$_ - 1] = read_file "$prefix$_.in" for 1 .. $meta{testcnt};
+	}
+
+	prompt_file \%meta, gen => '[Generator::Run] Generator' if $meta{generator} eq 'Run';
+
+	if ($meta{runner} eq 'File') {
+		my $prefix = prompt '[Runner::File] Output file prefix';
+		$meta{okfile}[$_ - 1] = read_file "$prefix$_.ok" for 1 .. $meta{testcnt};
+		$meta{tests}[$_ - 1] = prompt "[Runner::File] Score for test ${_} [10]", '-i', -default => 10 for 1 .. $meta{testcnt};
+	}
+
+	prompt_file \%meta, ver => '[Runner::Verifier] Verifier' if $meta{runner} eq 'Verifier';
+
+	if ($meta{runner} eq 'Interactive') {
+		say RED, 'WARNING: Runner::Interactive is experimental', RESET;
+		prompt_file int => '[Runner::Interactive] Interactive verifier';
+	}
+
+	insert_problem $id => name => $name, level => $level, statement => $statement, author => $author, owner => $owner;
+	set_problem_meta $id => \%meta;
+	PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
+	PUBLISH genpage => $contest ? "ct/$contest/pb/$id.html" : "pb/$id.html";
+}
+
+sub cmd_set{
+	my $file;
+	GetOptions ( 'file!' => \$file );
+	my ($id, %values) = @ARGV;
+	%values = map { $_ => scalar read_file $values{$_} } keys %values if $file;
+	edit_problem $id => %values;
+	PUBLISH genpage => 'pb/index.html';
+	PUBLISH genpage => "pb/$id.html";
+}
+
+sub cmd_list{
+	local $, = "\n";
+	say problems;
+}
+
+sub cmd_rm{
+	remove_problem shift;
+	PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
+}
+
+sub cmd_show{
+	local $_ = shift or goto &cmd_list;
+}
+
+##################################################
+
+GetOptions ( 'contest=s' => \$contest );
+local $Gruntmaster::Data::contest = $contest;
+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-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
+  
+
+=head1 DESCRIPTION
+
+
+
+=cut
diff --git a/lib/Gruntmaster/Data.pm b/lib/Gruntmaster/Data.pm
index 48de966..1b2492c 100644
--- a/lib/Gruntmaster/Data.pm
+++ b/lib/Gruntmaster/Data.pm
@@ -1,85 +1,102 @@
 package Gruntmaster::Data;
-
-use 5.014002;
-use strict;
+use v5.14;
 use warnings;
-
-require Exporter;
-
-our @ISA = qw(Exporter);
-
-# Items to export into callers namespace by default. Note: do not export
-# names by default without a very good reason. Use EXPORT_OK instead.
-# Do not simply export all your public functions/methods/constants.
-
-# This allows declaration	use Gruntmaster::Data ':all';
-# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
-# will save memory.
-our %EXPORT_TAGS = ( 'all' => [ qw(
-	
-) ] );
-
-our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
-
-our @EXPORT = qw(
-	
-);
-
-our $VERSION = '5999.000_001';
-$VERSION = eval $VERSION;  # see L<perlmodstyle>
-
-
-# Preloaded methods go here.
-
-1;
-__END__
-# Below is stub documentation for your module. You'd better edit it!
-
-=head1 NAME
-
-Gruntmaster::Data - Perl extension for blah blah blah
-
-=head1 SYNOPSIS
-
-  use Gruntmaster::Data;
-  blah blah blah
-
-=head1 DESCRIPTION
-
-Stub documentation for Gruntmaster::Data, created by h2xs. It looks like the
-author of the extension was negligent enough to leave the stub
-unedited.
-
-Blah blah blah.
-
-=head2 EXPORT
-
-None by default.
-
-
-
-=head1 SEE ALSO
-
-Mention other useful documentation such as the documentation of
-related modules or operating system documentation (such as man pages
-in UNIX), or any relevant external documentation such as RFCs or
-standards.
-
-If you have a mailing list set up for your module, mention it here.
-
-If you have a web site set up for your module, mention it here.
-
-=head1 AUTHOR
-
-Marius Gavrilescu, E<lt>marius@E<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.2 or,
-at your option, any later version of Perl 5 you may have available.
-
-
-=cut
+use parent qw/Exporter/;
+
+use JSON qw/encode_json decode_json/;
+
+use Redis;
+
+our $contest;
+my $redis = Redis->new;
+my $pubsub = Redis->new;
+
+sub dynsub{
+	no strict 'refs';
+	*{$_[0]} = $_[1];
+}
+
+BEGIN {
+	for my $cmd (qw/multi exec smembers get hget hdel hset sadd srem incr hmset hsetnx publish del/) {
+		dynsub uc $cmd, sub { $redis->$cmd(@_) };
+	}
+
+	for my $cmd (qw/subscribe wait_for_messages/) {
+		dynsub uc $cmd, sub { $pubsub->$cmd(@_) };
+	}
+}
+
+sub cp { defined $contest ? "contest.$contest." : '' }
+
+sub multi				()		{ MULTI }
+sub rexec				()		{ EXEC }
+
+sub problems			()		{ SMEMBERS cp . 'problem' }
+sub contests			()		{ SMEMBERS cp . 'contest' }
+sub users				()		{ SMEMBERS cp . 'user' }
+sub jobcard				()		{ GET cp . 'job' }
+
+sub job_results			(_)		{ decode_json HGET cp . "job.$_[0]", 'results' }
+sub set_job_results		($+)	{ HSET cp . "job.$_[0]", 'results', encode_json $_[1] }
+sub job_inmeta			(_)		{ decode_json HGET cp . "job.$_[0]", 'inmeta' }
+sub set_job_inmeta		($+)	{ HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] }
+sub problem_meta		(_)		{ decode_json HGET cp . "problem.$_[0]", 'meta' }
+sub set_problem_meta	($+)	{ HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] }
+sub job_daemon			(_)		{ HGET cp . "job.$_[0]", 'daemon' }
+sub set_job_daemon		($$)	{ HSETNX cp . "job.$_[0]", 'daemon', $_[1] };
+
+sub defhash{
+	my ($name, @keys) = @_;
+	for my $key (@keys) {
+		dynsub "${name}_$key", sub (_)  { HGET cp . "$name.$_[0]", $key };
+		dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
+	}
+
+	dynsub "edit_$name", sub {
+		my ($key, %values) = @_;
+		HMSET cp . "$name.$key", %values;
+	};
+
+	dynsub "insert_$name", sub {
+		my ($key, %values) = @_;
+		SADD cp . $name, $key or return;
+		HMSET cp . "$name.$key", %values;
+	};
+	dynsub "remove_$name", sub (_) {
+		my $key = shift;
+		SREM cp . $name, $key;
+		DEL cp . "$name.$key";
+	};
+
+	dynsub "push_$name", sub {
+		my $nr = INCR cp . $name;
+		HMSET cp . "$name.$nr", @_;
+		$nr
+	};
+}
+
+defhash problem => qw/name level statement owner author/;
+defhash contest => qw/start end name owner/;
+defhash job => qw/date errors extension filesize private problem result result_text user/;
+defhash user => qw/name email town university level/;
+
+sub clean_job (_){
+	HDEL cp . "job.$_[0]", qw/result result_text results daemon/
+}
+
+sub mark_open {
+	my ($problem, $user) = @_;
+	HSETNX cp . 'open', "$problem.$user", time;
+}
+
+sub get_open {
+	my ($problem, $user) = @_;
+	HGET cp . 'open', "$problem.$user";
+}
+
+our @EXPORT = do {
+	no strict 'refs';
+	grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
+};
+
+1
-- 
2.39.2