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 hdel hset sadd srem incr hmset hsetnx publish del/) {
  21                 dynsub uc $cmd, sub { $redis->$cmd(@_) };
  22         }
  23
  24         for my $cmd (qw/subscribe wait_for_messages/) {
  25                 dynsub uc $cmd, sub { $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 users                               ()              { SMEMBERS cp . 'user' }
  37 sub jobcard                             ()              { GET cp . 'job' }
  38
  39 sub job_results                 (_)             { decode_json HGET cp . "job.$_[0]", 'results' }
  40 sub set_job_results             ($+)    { HSET cp . "job.$_[0]", 'results', encode_json $_[1] }
  41 sub job_inmeta                  (_)             { decode_json HGET cp . "job.$_[0]", 'inmeta' }
  42 sub set_job_inmeta              ($+)    { HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] }
  43 sub problem_meta                (_)             { decode_json HGET cp . "problem.$_[0]", 'meta' }
  44 sub set_problem_meta    ($+)    { HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] }
  45 sub job_daemon                  (_)             { HGET cp . "job.$_[0]", 'daemon' }
  46 sub set_job_daemon              ($$)    { HSETNX cp . "job.$_[0]", 'daemon', $_[1] };
  47
  48 sub defhash{
  49         my ($name, @keys) = @_;
  50         for my $key (@keys) {
  51                 dynsub "${name}_$key", sub (_)  { HGET cp . "$name.$_[0]", $key };
  52                 dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
  53         }
  54
  55         dynsub "edit_$name", sub {
  56                 my ($key, %values) = @_;
  57                 HMSET cp . "$name.$key", %values;
  58         };
  59
  60         dynsub "insert_$name", sub {
  61                 my ($key, %values) = @_;
  62                 SADD cp . $name, $key or return;
  63                 HMSET cp . "$name.$key", %values;
  64         };
  65         dynsub "remove_$name", sub (_) {
  66                 my $key = shift;
  67                 SREM cp . $name, $key;
  68                 DEL cp . "$name.$key";
  69         };
  70
  71         dynsub "push_$name", sub {
  72                 my $nr = INCR cp . $name;
  73                 HMSET cp . "$name.$nr", @_;
  74                 $nr
  75         };
  76 }
  77
  78 defhash problem => qw/name level statement owner author/;
  79 defhash contest => qw/start end name owner/;
  80 defhash job => qw/date errors extension filesize private problem result result_text user/;
  81 defhash user => qw/name email town university level/;
  82
  83 sub clean_job (_){
  84         HDEL cp . "job.$_[0]", qw/result result_text results daemon/
  85 }
  86
  87 sub mark_open {
  88         my ($problem, $user) = @_;
  89         HSETNX cp . 'open', "$problem.$user", time;
  90 }
  91
  92 sub get_open {
  93         my ($problem, $user) = @_;
  94         HGET cp . 'open', "$problem.$user";
  95 }
  96
  97 our @EXPORT = do {
  98         no strict 'refs';
  99         grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
 100 };
 101
 102 1