More bug fixes

[gruntmaster-page.git] / lib / Gruntmaster / Data.pm

package Gruntmaster::Data;
use v5.14;
use warnings;
use parent qw/Exporter/;

use JSON qw/encode_json decode_json/;

use Redis;

our $contest;
my $redis = Redis->new;

sub dynsub{
	no strict 'refs';
	*{$_[0]} = $_[1];
}

BEGIN {
	for my $cmd (qw/multi exec smembers get hget hset sadd srem incr hmset hsetnx/) {
		dynsub uc $cmd, sub { say "Arguments to \U$cmd: ", join ', ', @_; $redis->$cmd(@_) };
	}
}

sub cp { defined $contest ? "contest.$contest." : '' }

sub multi				()		{ MULTI }
sub rexec				()		{ EXEC }

sub problems			()		{ SMEMBERS cp . 'problem' }
sub contests			()		{ SMEMBERS cp . 'contest' }
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 "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;
	};

	dynsub "push_$name", sub {
		my $nr = INCR cp . $name;
		HMSET cp . "$name.$nr", @_;
		$nr
	};
}

defhash problem => qw/name level statement/;
defhash contest => qw/start end name owner/;
defhash job => qw/date extension filesize private problem result result_text user/;

our @EXPORT_OK = do {
	no strict 'refs';
	grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
};

1