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 incr hmset/) {
  20                 dynsub uc $cmd, sub { say $cmd;exit;$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 problem_meta                (_)     { decode_json HGET cp . "pb.$_[0]", 'meta' }
  36 sub set_problem_meta    ($+)    { HSET cp . "pb.$_[0]", 'meta', encode_json $_[1] }
  37
  38 sub defhash{
  39         my ($name, @keys) = @_;
  40         for my $key (@keys) {
  41                 dynsub "${name}_$key", sub (_)  { HGET cp . "$name.$_[0]", $key };
  42                 dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
  43         }
  44
  45         dynsub "insert_$name", sub {
  46                 my ($key, %values) = @_;
  47                 SADD cp . $name, $key or return;
  48                 HMSET cp . "$name.$key", %values;
  49         };
  50         dynsub "push_$name", sub {
  51                 my $nr = INCR cp . $name;
  52                 HMSET cp . "$name.$nr", @_;
  53         };
  54 }
  55
  56 defhash problem => qw/name level statement/;
  57 defhash contest => qw/start end name owner/;
  58 defhash job => qw/date file name private problem result result_text user/;
  59
  60 our @EXPORT_OK = do {
  61         no strict 'refs';
  62         grep { $_ =~ /^[a-z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
  63 };
  64
  65 1