Name subs with Sub::Name

[gruntmaster-data.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;
use Sub::Name qw/subname/;

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

sub dynsub{
	our ($name, $sub) = @_;
	no strict 'refs';
	*$name = subname $name => $sub
}

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