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_002';
  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 lastjob 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 HGETALL 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_difficulty> I<$problem>
 169
 170 Returns a problem's difficulty.
 171
 172 =item B<set_problem_difficulty> I<$problem>, I<$name>
 173
 174 Sets a problem's difficulty.
 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<problem_private> I<$problem>
 201
 202 Returns a problem's private flag (true if the problem is private, false otherwise).
 203
 204 =item B<set_problem_private> I<$problem>, I<$private>
 205
 206 Sets a problem's private flag.
 207
 208 =item B<problem_generator> I<$problem>
 209
 210 Returns a problem's generator. The generators are File, Run and Undef. More might be added in the future.
 211
 212 =item B<set_problem_generator> I<$problem>, I<$generator>
 213
 214 Sets a problem's generator.
 215
 216 =item B<problem_runner> I<$problem>
 217
 218 Returns a problem's runner. The runners are File, Verifier and Interactive. More might be added in the future.
 219
 220 =item B<set_problem_runner> I<$problem>, I<$runner>
 221
 222 Sets a problem's runner.
 223
 224 =item B<problem_judge> I<$problem>
 225
 226 Returns a problem's judge. The judges are Absolute and Points. More might be added in the future.
 227
 228 =item B<set_problem_judge> I<$problem>, I<$judge>
 229
 230 Sets a problem's judge.
 231
 232 =item B<problem_testcnt> I<$problem>
 233
 234 Returns a problem's test count.
 235
 236 =item B<set_problem_testcnt> I<$problem>, I<$testcnt>
 237
 238 Sets a problem's test count.
 239
 240 =item B<problem_timeout> I<$problem>
 241
 242 Returns a problem's time limit, in seconds.
 243
 244 =item B<set_problem_timeout> I<$problem>, I<$timeout>
 245
 246 Sets a problem's time limit, in seconds.
 247
 248 =item B<problem_olimit> I<$problem>
 249
 250 Returns a problem's output limit, in bytes.
 251
 252 =item B<set_problem_olimit> I<$problem>, I<$olimit>
 253
 254 Sets a problem's output limit, in bytes.
 255
 256 =item B<get_open> I<$problem>, I<$user>
 257
 258 Returns the time when I<$user> opened I<$problem>.
 259
 260 =item B<mark_open> I<$problem>, I<$user>
 261
 262 Sets the time when I<$user> opened I<$problem> to the current time. Does nothing if I<$user> has already opened I<$problem>.
 263
 264 =item B<insert_problem> I<$id>, I<$key> => I<$value>, ...
 265
 266 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.
 267
 268 =item B<edit_problem> I<$id>, I<$key> => I<$value>, ...
 269
 270 Updates the configuration of a problem. The values of the given keys are updated. All other keys/values are left intact.
 271
 272 =item B<remove_problem> I<$id>
 273
 274 Removes a problem.
 275
 276 =back
 277
 278 =head2 Contests
 279
 280 B<<< WARNING: these functions only work correctly when C<< $Gruntmaster::Data::contest >> is undef >>>
 281
 282 =over
 283
 284 =item B<contests>
 285
 286 Returns a list of contests.
 287
 288 =item B<contest_start> I<$contest>
 289
 290 Returns a contest's start time.
 291
 292 =item B<set_contest_start> I<$contest>, I<$start>
 293
 294 Sets a contest's start time.
 295
 296 =item B<contest_end> I<$contest>
 297
 298 Returns a contest's end time.
 299
 300 =item B<set_contest_end> I<$contest>, I<$end>
 301
 302 Sets a contest's end time.
 303
 304 =item B<contest_name> I<$contest>
 305
 306 Returns a contest's name.
 307
 308 =item B<set_contest_name> I<$contest>, I<$name>
 309
 310 Sets a contest's name.
 311
 312 =item B<contest_owner> I<$contest>
 313
 314 Returns a contest's owner.
 315
 316 =item B<set_contest_owner> I<$contest>, I<$owner>
 317
 318 Sets a contest's owner.
 319
 320 =item B<insert_contest> I<$id>, I<$key> => I<$value>, ...
 321
 322 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.
 323
 324 =item B<edit_contest> I<$id>, I<$key> => I<$value>, ...
 325
 326 Updates the configuration of a contest. The values of the given keys are updated. All other keys/values are left intact.
 327
 328 =item B<remove_contest> I<$id>
 329
 330 Removes a contest.
 331
 332 =back
 333
 334 =head2 Jobs
 335
 336 =over
 337
 338 =item B<jobcard>
 339
 340 Returns the number of jobs in the database.
 341
 342 =item B<job_results> I<$job>
 343
 344 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).
 345
 346 =item B<set_job_results> I<$job>, I<$results>
 347
 348 Sets a job's results.
 349
 350 =item B<job_inmeta> I<$job>
 351
 352 Returns a job's meta.
 353
 354 =item B<set_job_inmeta> I<$job>, I<$meta>
 355
 356 Sets a job's meta.
 357
 358 =item B<job_daemon> I<$job>
 359
 360 Returns the hostname:pid of the daemon which ran this job.
 361
 362 =item B<set_job_daemon> I<$job>, I<$hostname_and_pid>
 363
 364 If the job has no associated daemon, it sets the daemon and returns true. Otherwise it returns false without setting the daemon.
 365
 366 =item B<job_date> I<$job>
 367
 368 Returns a job's submit date.
 369
 370 =item B<set_job_date> I<$job>, I<$date>
 371
 372 Sets a job's submit date.
 373
 374 =item B<job_errors> I<$job>
 375
 376 Returns a job's compile errors.
 377
 378 =item B<set_job_errors> I<$job>, I<$errors>
 379
 380 Sets a job's compile errors.
 381
 382 =item B<job_extension> I<$job>
 383
 384 Returns a job's file name extension (e.g. "cpp", "pl", "java").
 385
 386 =item B<set_job_extension> I<$job>, I<$extension>
 387
 388 Sets a job's file name extension.
 389
 390 =item B<job_filesize> I<$job>
 391
 392 Returns a job's source file size, in bytes.
 393
 394 =item B<set_job_filesize> I<$job>, I<$filesize>
 395
 396 Sets a job's source file size, in bytes.
 397
 398 =item B<job_private> I<$job>
 399
 400 Returns the value of a job's private flag.
 401
 402 =item B<set_job_private> I<$job>, I<$private>
 403
 404 Sets the value of a job's private flag.
 405
 406 =item B<job_problem> I<$job>
 407
 408 Returns a job's problem.
 409
 410 =item B<set_job_problem> I<$job>, I<$problem>
 411
 412 Sets a job's problem.
 413
 414 =item B<job_result> I<$job>
 415
 416 Returns a job's result code. Possible result codes are described in L<Gruntmaster::Daemon::Constants>
 417
 418 =item B<set_job_result> I<$job>, I<$result>
 419
 420 Sets a job's result code.
 421
 422 =item B<job_result_text> I<$job>
 423
 424 Returns a job's result text.
 425
 426 =item B<set_job_result_text> I<$job>, I<$result_text>
 427
 428 Sets a job's result text.
 429
 430 =item B<job_user> I<$job>
 431
 432 Returns the user who submitted a job.
 433
 434 =item B<set_job_user> I<$job>, I<$user>
 435
 436 Sets the suer who submitted a job.
 437
 438 =item B<clean_job> I<$job>
 439
 440 Removes a job's daemon, result code, result text and result array.
 441
 442 =item B<push_job> I<$key> => I<$value>, ...
 443
 444 Inserts a job with a given initial configuration. Returns the id of the newly-added job.
 445
 446 =item B<edit_job> I<$id>, I<$key> => I<$value>, ...
 447
 448 Updates the configuration of a job. The values of the given keys are updated. All other keys/values are left intact.
 449
 450 =item B<remove_job> I<$id>
 451
 452 Removes a job.
 453
 454 =back
 455
 456 =head2 Users
 457
 458 B<<< WARNING: these functions only work correctly when C<< $Gruntmaster::Data::contest >> is undef >>>
 459
 460 =over
 461
 462 =item B<users>
 463
 464 Returns a list of users.
 465
 466 =item B<user_name> I<$user>
 467
 468 Returns a user's full name.
 469
 470 =item B<set_user_name> I<$user>, I<$name>
 471
 472 Sets a user's full name.
 473
 474 =item B<user_email> I<$user>
 475
 476 Returns a user's email address.
 477
 478 =item B<set_user_email> I<$user>, I<$email>
 479
 480 Sets a user's email address.
 481
 482 =item B<user_lastjob> I<$user>
 483
 484 Returns the time (seconds since epoch) when the user last submitted a solution.
 485
 486 =item B<set_user_lastjob> I<$user>, I<$lastjob>
 487
 488 Sets the time (seconds since epoch) when the user last submitted a solution.
 489
 490 =item B<user_town> I<$user>
 491
 492 Returns a user's town.
 493
 494 =item B<set_user_town> I<$user>, I<$town>
 495
 496 Sets a user's town.
 497
 498 =item B<user_university> I<$user>
 499
 500 Returns a user's university/highschool/place of work/etc.
 501
 502 =item B<set_user_university> I<$user>, I<$university>
 503
 504 Sets a user's university, highschool/place of work/etc.
 505
 506 =item B<user_level> I<$user>
 507
 508 Returns a user's current level of study. One of 'Highschool', 'Undergraduate', 'Master', 'Doctorate' or 'Other'.
 509
 510 =item B<set_user_level> I<$user>, I<$level>
 511
 512 Sets a user's current level of study.
 513
 514 =item B<insert_user> I<$id>, I<$key> => I<$value>, ...
 515
 516 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.
 517
 518 =item B<edit_user> I<$id>, I<$key> => I<$value>, ...
 519
 520 Updates the configuration of a user. The values of the given keys are updated. All other keys/values are left intact.
 521
 522 =item B<remove_user> I<$id>
 523
 524 Removes a user.
 525
 526 =back
 527
 528 =head1 AUTHOR
 529
 530 Marius Gavrilescu E<lt>marius@ieval.roE<gt>
 531
 532 =head1 COPYRIGHT AND LICENSE
 533
 534 Copyright (C) 2014 by Marius Gavrilescu
 535
 536 This library is free software: you can redistribute it and/or modify
 537 it under the terms of the GNU Affero General Public License as published by
 538 the Free Software Foundation, either version 3 of the License, or
 539 (at your option) any later version.
 540
 541
 542 =cut