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 $VERSION = '5999.000_001';
  11
  12 our $contest;
  13 my $redis = Redis->new;
  14 my $pubsub = Redis->new;
  15
  16 sub dynsub{
  17         our ($name, $sub) = @_;
  18         no strict 'refs';
  19         *$name = subname $name => $sub
  20 }
  21
  22 BEGIN {
  23         for my $cmd (qw/multi exec smembers get hget hdel hset sadd srem incr hmset hsetnx publish del/) {
  24                 dynsub uc $cmd, sub { $redis->$cmd(@_) };
  25         }
  26
  27         for my $cmd (qw/subscribe wait_for_messages/) {
  28                 dynsub uc $cmd, sub { $pubsub->$cmd(@_) };
  29         }
  30 }
  31
  32 sub cp { defined $contest ? "contest.$contest." : '' }
  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;
 103 __END__
 104
 105 =encoding utf-8
 106
 107 =head1 NAME
 108
 109 Gruntmaster::Data - Gruntmaster 6000 Online Judge -- database interface and tools
 110
 111 =head1 SYNOPSIS
 112
 113   for my $problem (problems) {
 114     say "Problem name: " . problem_name $problem;
 115     say "Problem level: " . problem_level $problem;
 116     ...
 117   }
 118
 119 =head1 DESCRIPTION
 120
 121 Gruntmaster::Data is the Redis interface used by the Gruntmaster 6000 Online Judge. It exports many functions for talking to the database. All functions are exported by default.
 122
 123 The current contest is selected by setting the C<< $Gruntmaster::Data::contest >> variable.
 124
 125   local $Gruntmaster::Data::contest = 'mycontest';
 126   say 'There are' . jobcard . ' jobs in my contest';
 127
 128 =head1 FUNCTIONS
 129
 130 =head2 Redis
 131
 132 Gruntmaster::Data exports some functions for talking directly to the Redis server. These functions should not normally be used, except for B<MULTI>, B<EXEC>, B<PUBLISH>, B<SUBSCRIBE> and B<WAIT_FOR_MESSAGES>.
 133
 134 These functions correspond to Redis commands. The current list is: B<< MULTI EXEC SMEMBERS GET HGET HDEL HSET SADD SREM INCR HMSET HSETNX DEL PUBLISH SUBSCRIBE WAIT_FOR_MESSAGES >>.
 135
 136 =head2 Problems
 137
 138 =over
 139
 140 =item B<problems>
 141
 142 Returns a list of problems in the current contest.
 143
 144 =item B<problem_meta> I<$problem>
 145
 146 Returns a problem's meta.
 147
 148 =item B<set_problem_meta> I<$problem>, I<$meta>
 149
 150 Sets a problem's meta.
 151
 152 =item B<problem_name> I<$problem>
 153
 154 Returns a problem's name.
 155
 156 =item B<set_problem_name> I<$problem>, I<$name>
 157
 158 Sets a problem's name.
 159
 160 =item B<problem_level> I<$problem>
 161
 162 Returns a problem's level. The levels are beginner, easy, medium, hard.
 163
 164 =item B<set_problem_level> I<$problem>, I<$level>
 165
 166 Sets a problem's level. The levels are beginner, easy, medium, hard.
 167
 168 =item B<problem_statement> I<$problem>
 169
 170 Returns a problem's statement.
 171
 172 =item B<set_problem_statement> I<$problem>, I<$statement>
 173
 174 Sets a problem's statement.
 175
 176 =item B<problem_owner> I<$problem>
 177
 178 Returns a problem's owner.
 179
 180 =item B<set_problem_owner> I<$problem>, I<$owner>
 181
 182 Sets a problem's owner.
 183
 184 =item B<problem_author> I<$problem>
 185
 186 Returns a problem's author.
 187
 188 =item B<set_problem_author> I<$problem>, I<$author>
 189
 190 Sets a problem's author.
 191
 192 =item B<get_open> I<$problem>, I<$user>
 193
 194 Returns the time when I<$user> opened I<$problem>.
 195
 196 =item B<mark_open> I<$problem>, I<$user>
 197
 198 Sets the time when I<$user> opened I<$problem> to the current time. Does nothing if I<$user> has already opened I<$problem>.
 199
 200 =item B<insert_problem> I<$id>, I<$key> => I<$value>, ...
 201
 202 Inserts a problem with id I<$id> and the given initial configuration. Does nothing if a problem with id I<$id> already exists. Returns true if the problem was added, false otherwise.
 203
 204 =item B<edit_problem> I<$id>, I<$key> => I<$value>, ...
 205
 206 Updates the configuration of a problem. The values of the given keys are updated. All other keys/values are left intact.
 207
 208 =item B<remove_problem> I<$id>
 209
 210 Removes a problem.
 211
 212 =back
 213
 214 =head2 Contests
 215
 216 B<<< WARNING: these functions only work correctly when C<< $Gruntmaster::Data::contest >> is undef >>>
 217
 218 =over
 219
 220 =item B<contests>
 221
 222 Returns a list of contests.
 223
 224 =item B<contest_start> I<$contest>
 225
 226 Returns a contest's start time.
 227
 228 =item B<set_contest_start> I<$contest>, I<$start>
 229
 230 Sets a contest's start time.
 231
 232 =item B<contest_end> I<$contest>
 233
 234 Returns a contest's end time.
 235
 236 =item B<set_contest_end> I<$contest>, I<$end>
 237
 238 Sets a contest's end time.
 239
 240 =item B<contest_name> I<$contest>
 241
 242 Returns a contest's name.
 243
 244 =item B<set_contest_name> I<$contest>, I<$name>
 245
 246 Sets a contest's name.
 247
 248 =item B<contest_owner> I<$contest>
 249
 250 Returns a contest's owner.
 251
 252 =item B<set_contest_owner> I<$contest>, I<$owner>
 253
 254 Sets a contest's owner.
 255
 256 =item B<insert_contest> I<$id>, I<$key> => I<$value>, ...
 257
 258 Inserts a contest with id I<$id> and the given initial configuration. Does nothing if a contest with id I<$id> already exists. Returns true if the contest was added, false otherwise.
 259
 260 =item B<edit_contest> I<$id>, I<$key> => I<$value>, ...
 261
 262 Updates the configuration of a contest. The values of the given keys are updated. All other keys/values are left intact.
 263
 264 =item B<remove_contest> I<$id>
 265
 266 Removes a contest.
 267
 268 =back
 269
 270 =head2 Jobs
 271
 272 =over
 273
 274 =item B<jobcard>
 275
 276 Returns the number of jobs in the database.
 277
 278 =item B<job_results> I<$job>
 279
 280 Returns an array of job results. Each element corresponds to a test and is a hashref with keys B<id> (test number), B<result> (result code, see L<Gruntmaster::Daemon::Constants>), B<result_text> (result description) and B<time> (time taken).
 281
 282 =item B<set_job_results> I<$job>, I<$results>
 283
 284 Sets a job's results.
 285
 286 =item B<job_inmeta> I<$job>
 287
 288 Returns a job's meta.
 289
 290 =item B<set_job_inmeta> I<$job>, I<$meta>
 291
 292 Sets a job's meta.
 293
 294 =item B<job_daemon> I<$job>
 295
 296 Returns the hostname:pid of the daemon which ran this job.
 297
 298 =item B<set_job_daemon> I<$job>, I<$hostname_and_pid>
 299
 300 If the job has no associated daemon, it sets the daemon and returns true. Otherwise it returns false without setting the daemon.
 301
 302 =item B<job_date> I<$job>
 303
 304 Returns a job's submit date.
 305
 306 =item B<set_job_date> I<$job>, I<$date>
 307
 308 Sets a job's submit date.
 309
 310 =item B<job_errors> I<$job>
 311
 312 Returns a job's compile errors.
 313
 314 =item B<set_job_errors> I<$job>, I<$errors>
 315
 316 Sets a job's compile errors.
 317
 318 =item B<job_extension> I<$job>
 319
 320 Returns a job's file name extension (e.g. "cpp", "pl", "java").
 321
 322 =item B<set_job_extension> I<$job>, I<$extension>
 323
 324 Sets a job's file name extension.
 325
 326 =item B<job_filesize> I<$job>
 327
 328 Returns a job's source file size, in bytes.
 329
 330 =item B<set_job_filesize> I<$job>, I<$filesize>
 331
 332 Sets a job's source file size, in bytes.
 333
 334 =item B<job_private> I<$job>
 335
 336 Returns the value of a job's private flag.
 337
 338 =item B<set_job_private> I<$job>, I<$private>
 339
 340 Sets the value of a job's private flag.
 341
 342 =item B<job_problem> I<$job>
 343
 344 Returns a job's problem.
 345
 346 =item B<set_job_problem> I<$job>, I<$problem>
 347
 348 Sets a job's problem.
 349
 350 =item B<job_result> I<$job>
 351
 352 Returns a job's result code. Possible result codes are described in L<Gruntmaster::Daemon::Constants>
 353
 354 =item B<set_job_result> I<$job>, I<$result>
 355
 356 Sets a job's result code.
 357
 358 =item B<job_result_text> I<$job>
 359
 360 Returns a job's result text.
 361
 362 =item B<set_job_result_text> I<$job>, I<$result_text>
 363
 364 Sets a job's result text.
 365
 366 =item B<job_user> I<$job>
 367
 368 Returns the user who submitted a job.
 369
 370 =item B<set_job_user> I<$job>, I<$user>
 371
 372 Sets the suer who submitted a job.
 373
 374 =item B<clean_job> I<$job>
 375
 376 Removes a job's daemon, result code, result text and result array.
 377
 378 =item B<push_job> I<$key> => I<$value>, ...
 379
 380 Inserts a job with a given initial configuration. Returns the id of the newly-added job.
 381
 382 =item B<edit_job> I<$id>, I<$key> => I<$value>, ...
 383
 384 Updates the configuration of a job. The values of the given keys are updated. All other keys/values are left intact.
 385
 386 =item B<remove_job> I<$id>
 387
 388 Removes a job.
 389
 390 =back
 391
 392 =head2 Users
 393
 394 B<<< WARNING: these functions only work correctly when C<< $Gruntmaster::Data::contest >> is undef >>>
 395
 396 =over
 397
 398 =item B<users>
 399
 400 Returns a list of users.
 401
 402 =item B<user_name> I<$user>
 403
 404 Returns a user's full name.
 405
 406 =item B<set_user_name> I<$user>, I<$name>
 407
 408 Sets a user's full name.
 409
 410 =item B<user_email> I<$user>
 411
 412 Returns a user's email address.
 413
 414 =item B<set_user_email> I<$user>, I<$email>
 415
 416 Sets a user's email address.
 417
 418 =item B<user_town> I<$user>
 419
 420 Returns a user's town.
 421
 422 =item B<set_user_town> I<$user>, I<$town>
 423
 424 Sets a user's town.
 425
 426 =item B<user_university> I<$user>
 427
 428 Returns a user's university/highschool/place of work/etc.
 429
 430 =item B<set_user_university> I<$user>, I<$university>
 431
 432 Sets a user's university, highschool/place of work/etc.
 433
 434 =item B<user_level> I<$user>
 435
 436 Returns a user's current level of study. One of 'Highschool', 'Undergraduate', 'Master', 'Doctorate' or 'Other'.
 437
 438 =item B<set_user_level> I<$user>, I<$level>
 439
 440 Sets a user's current level of study.
 441
 442 =item B<insert_user> I<$id>, I<$key> => I<$value>, ...
 443
 444 Inserts a user with id I<$id> and the given initial configuration. Does nothing if a user with id I<$id> already exists. Returns true if the user was added, false otherwise.
 445
 446 =item B<edit_user> I<$id>, I<$key> => I<$value>, ...
 447
 448 Updates the configuration of a user. The values of the given keys are updated. All other keys/values are left intact.
 449
 450 =item B<remove_user> I<$id>
 451
 452 Removes a user.
 453
 454 =back
 455
 456 =head1 AUTHOR
 457
 458 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
 459
 460 =head1 COPYRIGHT AND LICENSE
 461
 462 Copyright (C) 2014 by Marius Gavrilescu
 463
 464 This library is free software: you can redistribute it and/or modify
 465 it under the terms of the GNU Affero General Public License as published by
 466 the Free Software Foundation, either version 3 of the License, or
 467 (at your option) any later version.
 468
 469
 470 =cut