+++ /dev/null
-#!/usr/bin/perl -w
-use v5.14;
-
-use Gruntmaster::Data;
-
-use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
-use POSIX qw/strftime/;
-use Date::Parse qw/str2time/;
-
-##################################################
-
-sub cmd_help{
- exec perldoc => $0
-}
-
-sub cmd_list{
- local $, = "\n";
- say contests;
-}
-
-sub cmd_show{
- local $_ = shift or goto &cmd_list;
- say "Name: ", contest_name;
- say "Owner: ", contest_owner;
- say "Start: ", strftime '%c', localtime contest_start;
- say "End: ", strftime '%c', localtime contest_end;
-}
-
-sub cmd_add{
- my $id = shift;
- my $name = prompt 'Contest name';
- my $owner = prompt 'Owner';
- my $start = str2time prompt 'Start time' or die 'Cannot parse time';
- my $end = str2time prompt 'End time' or die 'Cannot parse time';
-
- insert_contest $id => name => $name, owner => $owner, start => $start, end => $end;
- PUBLISH genpage => "ct/$id/index.html";
- PUBLISH genpage => "ct/index.html";
-}
-
-sub cmd_rm{
- remove_contest shift;
- PUBLISH genpage => "ct/index.html";
-}
-
-##################################################
-
-no strict 'refs';
-my $cmd = 'cmd_' . shift;
-cmd_help unless exists $main::{$cmd};
-$cmd->(@ARGV) if exists $main::{$cmd};
-
-1;
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-gruntmaster-contest - shell interface to Gruntmaster 6000 contests
-
-=head1 SYNOPSIS
-
- gruntmaster-contest list
- gruntmaster-contest show id
- gruntmaster-contest add id
- gruntmaster-contest rm id
-
-=head1 DESCRIPTION
-
-
-
-=cut
+++ /dev/null
-#!/usr/bin/perl -w
-use v5.14;
-
-use Gruntmaster::Data;
-
-use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
-use File::Slurp qw/read_file/;
-use Getopt::Long;
-use Term::ANSIColor qw/RED RESET/;
-use POSIX qw/strftime/;
-
-##################################################
-
-my $contest;
-
-sub cmd_help{
- exec perldoc => $0
-}
-
-sub cmd_card{
- say jobcard;
-}
-
-sub cmd_show{
- local $_ = shift or goto &cmd_list;
- say "Date: " , strftime ('%c', localtime job_date);
- say "User: ", job_user;
- say "Problem: ", problem_name job_problem;
- say "Extension: ", job_extension;
- say "Size: ", sprintf "%.2fKB", job_filesize() / 1024;
- say "Private: ", (job_private() ? 'yes' : 'no');
- say "Result text: ", job_result_text;
- say "Daemon: ", job_daemon;
- say "Compile errors: ", job_errors;
-}
-
-sub cmd_rerun{
- local $_ = shift or goto &cmd_list;
- clean_job;
- $contest//='';
- PUBLISH jobs => "$contest.$_";
-}
-
-##################################################
-
-GetOptions ( 'contest=s' => \$contest );
-local $Gruntmaster::Data::contest = $contest;
-my $cmd = 'cmd_' . shift;
-cmd_help unless exists $main::{$cmd};
-no strict 'refs';
-$cmd->(@ARGV) if exists $main::{$cmd};
-
-1;
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-gruntmaster-job - shell interface to Gruntmaster 6000 job log
-
-=head1 SYNOPSIS
-
- gruntmaster-job card
- gruntmaster-job show 5
- gruntmaster-job rerun 7
-
-=head1 DESCRIPTION
-
-
-
-=cut
+++ /dev/null
-#!/usr/bin/perl -w
-use v5.14;
-
-use Gruntmaster::Data;
-use Gruntmaster::Page::Submit;
-
-use IO::Prompter [ -style => 'bold', '-stdio', '-verbatim' ];
-use File::Slurp qw/read_file/;
-use Term::ANSIColor qw/RED RESET/;
-use Getopt::Long qw/GetOptions/;
-
-##################################################
-
-my $contest;
-
-sub cmd_help{
- exec perldoc => $0
-}
-
-sub prompt_file{
- my ($meta, $name, $prefix) = @_;
- my $filename = prompt '$prefix filename', -complete => 'filenames';
- $meta->{files}{$name}{content} = read_file $filename;
- $meta->{files}{$name}{format} = prompt '$prefix format', -menu => Gruntmaster::Page::Submit::FORMATS;
- $meta->{files}{$name}{name} = prompt "$prefix filename [$filename]", -default => $filename;
-}
-
-sub cmd_add{
- my $id = shift;
- my $name = prompt 'Problem name';
- my $author = prompt 'Problem author (full name)';
- my $owner = prompt 'Problem owner (username)';
- my $level = prompt 'Problem level', -menu => "beginner\neasy\nmedium\nhard";
- my $statement = read_file prompt 'File with problem statement', -complete => 'filenames';
- my %meta;
- $meta{generator} = prompt 'Generator', -menu => "File\nRun\nUndef";
- $meta{runner} = prompt 'Runner', -menu => "File\nVerifier\nInteractive";
- $meta{judge} = prompt 'Judge', -menu => "Absolute\nPoints";
- $meta{testcnt} = prompt 'Test count', '-i';
-
- $meta{timeout} = prompt 'Time limit (seconds)', '-n';
- delete $meta{timeout} unless $meta{timeout};
- $meta{olimit} = prompt 'Output limit (bytes)', '-i';
- delete $meta{olimit} unless $meta{olimit};
- say 'Memory limits are broken, so I won\'t ask you for one';
-
- if ($meta{generator} eq 'File') {
- my $prefix = prompt '[Generator::File] Input file prefix';
- $meta{infile}[$_ - 1] = read_file "$prefix$_.in" for 1 .. $meta{testcnt};
- }
-
- prompt_file \%meta, gen => '[Generator::Run] Generator' if $meta{generator} eq 'Run';
-
- if ($meta{runner} eq 'File') {
- my $prefix = prompt '[Runner::File] Output file prefix';
- $meta{okfile}[$_ - 1] = read_file "$prefix$_.ok" for 1 .. $meta{testcnt};
- $meta{tests}[$_ - 1] = prompt "[Runner::File] Score for test ${_} [10]", '-i', -default => 10 for 1 .. $meta{testcnt};
- }
-
- prompt_file \%meta, ver => '[Runner::Verifier] Verifier' if $meta{runner} eq 'Verifier';
-
- if ($meta{runner} eq 'Interactive') {
- say RED, 'WARNING: Runner::Interactive is experimental', RESET;
- prompt_file int => '[Runner::Interactive] Interactive verifier';
- }
-
- insert_problem $id => name => $name, level => $level, statement => $statement, author => $author, owner => $owner;
- set_problem_meta $id => \%meta;
- PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
- PUBLISH genpage => $contest ? "ct/$contest/pb/$id.html" : "pb/$id.html";
-}
-
-sub cmd_set{
- my $file;
- GetOptions ( 'file!' => \$file );
- my ($id, %values) = @ARGV;
- %values = map { $_ => scalar read_file $values{$_} } keys %values if $file;
- edit_problem $id => %values;
- PUBLISH genpage => 'pb/index.html';
- PUBLISH genpage => "pb/$id.html";
-}
-
-sub cmd_list{
- local $, = "\n";
- say problems;
-}
-
-sub cmd_rm{
- remove_problem shift;
- PUBLISH genpage => $contest ? "ct/$contest/pb/index.html" : 'pb/index.html';
-}
-
-sub cmd_show{
- local $_ = shift or goto &cmd_list;
-}
-
-##################################################
-
-GetOptions ( 'contest=s' => \$contest );
-local $Gruntmaster::Data::contest = $contest;
-my $cmd = 'cmd_' . shift;
-cmd_help unless exists $main::{$cmd};
-no strict 'refs';
-$cmd->(@ARGV) if exists $main::{$cmd};
-
-1;
-__END__
-
-=encoding utf-8
-
-=head1 NAME
-
-gruntmaster-problem - shell interface to Gruntmaster 6000 problems
-
-=head1 SYNOPSIS
-
- gruntmaster-problem add problem_id
- gruntmaster-problem list
- gruntmaster-problem rm problem_id
- gruntmaster-problem show problem_id
-
-
-=head1 DESCRIPTION
-
-
-
-=cut
+++ /dev/null
-package Gruntmaster::Data;
-use v5.14;
-use warnings;
-use parent qw/Exporter/;
-
-use JSON qw/encode_json decode_json/;
-
-use Redis;
-
-our $contest;
-my $redis = Redis->new;
-my $pubsub = Redis->new;
-
-sub dynsub{
- no strict 'refs';
- *{$_[0]} = $_[1];
-}
-
-BEGIN {
- for my $cmd (qw/multi exec smembers get hget hdel hset sadd srem incr hmset hsetnx publish del/) {
- dynsub uc $cmd, sub { $redis->$cmd(@_) };
- }
-
- for my $cmd (qw/subscribe wait_for_messages/) {
- dynsub uc $cmd, sub { $pubsub->$cmd(@_) };
- }
-}
-
-sub cp { defined $contest ? "contest.$contest." : '' }
-
-sub multi () { MULTI }
-sub rexec () { EXEC }
-
-sub problems () { SMEMBERS cp . 'problem' }
-sub contests () { SMEMBERS cp . 'contest' }
-sub users () { SMEMBERS cp . 'user' }
-sub jobcard () { GET cp . 'job' }
-
-sub job_results (_) { decode_json HGET cp . "job.$_[0]", 'results' }
-sub set_job_results ($+) { HSET cp . "job.$_[0]", 'results', encode_json $_[1] }
-sub job_inmeta (_) { decode_json HGET cp . "job.$_[0]", 'inmeta' }
-sub set_job_inmeta ($+) { HSET cp . "job.$_[0]", 'inmeta', encode_json $_[1] }
-sub problem_meta (_) { decode_json HGET cp . "problem.$_[0]", 'meta' }
-sub set_problem_meta ($+) { HSET cp . "problem.$_[0]", 'meta', encode_json $_[1] }
-sub job_daemon (_) { HGET cp . "job.$_[0]", 'daemon' }
-sub set_job_daemon ($$) { HSETNX cp . "job.$_[0]", 'daemon', $_[1] };
-
-sub defhash{
- my ($name, @keys) = @_;
- for my $key (@keys) {
- dynsub "${name}_$key", sub (_) { HGET cp . "$name.$_[0]", $key };
- dynsub "set_${name}_$key", sub ($$) { HSET cp . "$name.$_[0]", $key, $_[1] };
- }
-
- dynsub "edit_$name", sub {
- my ($key, %values) = @_;
- HMSET cp . "$name.$key", %values;
- };
-
- dynsub "insert_$name", sub {
- my ($key, %values) = @_;
- SADD cp . $name, $key or return;
- HMSET cp . "$name.$key", %values;
- };
- dynsub "remove_$name", sub (_) {
- my $key = shift;
- SREM cp . $name, $key;
- DEL cp . "$name.$key";
- };
-
- dynsub "push_$name", sub {
- my $nr = INCR cp . $name;
- HMSET cp . "$name.$nr", @_;
- $nr
- };
-}
-
-defhash problem => qw/name level statement owner author/;
-defhash contest => qw/start end name owner/;
-defhash job => qw/date errors extension filesize private problem result result_text user/;
-defhash user => qw/name email town university level/;
-
-sub clean_job (_){
- HDEL cp . "job.$_[0]", qw/result result_text results daemon/
-}
-
-sub mark_open {
- my ($problem, $user) = @_;
- HSETNX cp . 'open', "$problem.$user", time;
-}
-
-sub get_open {
- my ($problem, $user) = @_;
- HGET cp . 'open', "$problem.$user";
-}
-
-our @EXPORT = do {
- no strict 'refs';
- grep { $_ =~ /^[a-zA-Z]/ and exists &$_ } keys %{__PACKAGE__ . '::'};
-};
-
-1
projects / gruntmaster-page.git / commitdiff