]>
Commit | Line | Data |
---|---|---|
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 hset sadd srem incr hmset hsetnx/) { | |
21 | dynsub uc $cmd, sub { say "Arguments to \U$cmd: ", join ', ', @_; $redis->$cmd(@_) }; | |
22 | } | |
23 | ||
24 | for my $cmd (qw/publish subscribe wait_for_messages/) { | |
25 | dynsub uc $cmd, sub { say "Arguments to \U$cmd: ", join ', ', @_; $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 jobcard () { GET cp . 'job' } | |
37 | ||
38 | sub job_results (_) { decode_json HGET cp . "job.$_[0]", 'results' } | |
39 | sub set_job_results ($+) { HSET cp . "job.$_[0]", 'results', encode_json $_[1] } | |
40 | sub job_inmeta (_) { decode_json HGET cp . "job.$_[0]", 'inmeta' } | |
41 | sub set_job_inmeta ($+) { HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] } | |
42 | sub problem_meta (_) { decode_json HGET cp . "problem.$_[0]", 'meta' } | |
43 | sub set_problem_meta ($+) { HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] } | |
44 | sub job_daemon (_) { HGET cp . "job.$_[0]", 'daemon' } | |
45 | sub set_job_daemon ($$) { HSETNX cp . "job.$_[0]", 'daemon', $_[1] }; | |
46 | ||
47 | sub defhash{ | |
48 | my ($name, @keys) = @_; | |
49 | for my $key (@keys) { | |
50 | dynsub "${name}_$key", sub (_) { HGET cp . "$name.$_[0]", $key }; | |
51 | dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] }; | |
52 | } | |
53 | ||
54 | dynsub "insert_$name", sub { | |
55 | my ($key, %values) = @_; | |
56 | SADD cp . $name, $key or return; | |
57 | HMSET cp . "$name.$key", %values; | |
58 | }; | |
59 | dynsub "remove_$name", sub (_) { | |
60 | my $key = shift; | |
61 | SREM cp . $name, $key; | |
62 | }; | |
63 | ||
64 | dynsub "push_$name", sub { | |
65 | my $nr = INCR cp . $name; | |
66 | HMSET cp . "$name.$nr", @_; | |
67 | $nr | |
68 | }; | |
69 | } | |
70 | ||
71 | defhash problem => qw/name level statement/; | |
72 | defhash contest => qw/start end name owner/; | |
73 | defhash job => qw/date extension filesize private problem result result_text user/; | |
74 | defhash user => qw/name email town university/; | |
75 | ||
76 | our @EXPORT_OK = do { | |
77 | no strict 'refs'; | |
78 | grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'}; | |
79 | }; | |
80 | ||
81 | 1 |