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