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