lib/Gruntmaster/Data.pm

   1 package Gruntmaster::Data;
   2 use v5.14;
   3 use warnings;
   4 use parent qw/Exporter/;
   5
   6 use JSON qw/encode_json decode_json/;
   7
   8 use Redis;
   9
  10 our $contest;
  11 my $redis = Redis->new;
  12 my $pubsub = Redis->new;
  13
  14 sub dynsub{
  15         no strict 'refs';
  16         *{$_[0]} = $_[1];
  17 }
  18
  19 BEGIN {
  20         for my $cmd (qw/multi exec smembers get hget hset sadd srem incr hmset hsetnx/) {
  21                 dynsub uc $cmd, sub { say "Arguments to \U$cmd: ", join ', ', @_; $redis->$cmd(@_) };
  22         }
  23
  24         for my $cmd (qw/publish subscribe wait_for_messages/) {
  25                 dynsub uc $cmd, sub { say "Arguments to \U$cmd: ", join ', ', @_; $pubsub->$cmd(@_) };
  26         }
  27 }
  28
  29 sub cp { defined $contest ? "contest.$contest." : '' }
  30
  31 sub multi                               ()              { MULTI }
  32 sub rexec                               ()              { EXEC }
  33
  34 sub problems                    ()              { SMEMBERS cp . 'problem' }
  35 sub contests                    ()              { SMEMBERS cp . 'contest' }
  36 sub jobcard                             ()              { GET cp . 'job' }
  37
  38 sub job_results                 (_)             { decode_json HGET cp . "job.$_[0]", 'results' }
  39 sub set_job_results             ($+)    { HSET cp . "job.$_[0]", 'results', encode_json $_[1] }
  40 sub job_inmeta                  (_)             { decode_json HGET cp . "job.$_[0]", 'inmeta' }
  41 sub set_job_inmeta              ($+)    { HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] }
  42 sub problem_meta                (_)             { decode_json HGET cp . "problem.$_[0]", 'meta' }
  43 sub set_problem_meta    ($+)    { HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] }
  44 sub job_daemon                  (_)             { HGET cp . "job.$_[0]", 'daemon' }
  45 sub set_job_daemon              ($$)    { HSETNX cp . "job.$_[0]", 'daemon', $_[1] };
  46
  47 sub defhash{
  48         my ($name, @keys) = @_;
  49         for my $key (@keys) {
  50                 dynsub "${name}_$key", sub (_)  { HGET cp . "$name.$_[0]", $key };
  51                 dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
  52         }
  53
  54         dynsub "insert_$name", sub {
  55                 my ($key, %values) = @_;
  56                 SADD cp . $name, $key or return;
  57                 HMSET cp . "$name.$key", %values;
  58         };
  59         dynsub "remove_$name", sub (_) {
  60                 my $key = shift;
  61                 SREM cp . $name, $key;
  62         };
  63
  64         dynsub "push_$name", sub {
  65                 my $nr = INCR cp . $name;
  66                 HMSET cp . "$name.$nr", @_;
  67                 $nr
  68         };
  69 }
  70
  71 defhash problem => qw/name level statement/;
  72 defhash contest => qw/start end name owner/;
  73 defhash job => qw/date extension filesize private problem result result_text user/;
  74
  75 our @EXPORT_OK = do {
  76         no strict 'refs';
  77         grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
  78 };
  79
  80 1