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