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/) {
  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 "insert_$name", sub {
  56                 my ($key, %values) = @_;
  57                 SADD cp . $name, $key or return;
  58                 HMSET cp . "$name.$key", %values;
  59         };
  60         dynsub "remove_$name", sub (_) {
  61                 my $key = shift;
  62                 SREM cp . $name, $key;
  63         };
  64
  65         dynsub "push_$name", sub {
  66                 my $nr = INCR cp . $name;
  67                 HMSET cp . "$name.$nr", @_;
  68                 $nr
  69         };
  70 }
  71
  72 defhash problem => qw/name level statement owner author/;
  73 defhash contest => qw/start end name owner/;
  74 defhash job => qw/date extension filesize private problem result result_text user/;
  75 defhash user => qw/name email town university level/;
  76
  77 sub clean_job (_){
  78         HDEL cp . "job.$_[0]", qw/result result_text results daemon/
  79 }
  80
  81 our @EXPORT = do {
  82         no strict 'refs';
  83         grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
  84 };
  85
  86 1