From e9e5c8a440a6e3a088a4b9330650e310561ef518 Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sun, 2 Feb 2014 12:32:23 +0200 Subject: [PATCH] Move Gruntmaster::Data and database tools to another repository --- gruntmaster-contest | 73 ----------------------- gruntmaster-job | 72 ----------------------- gruntmaster-problem | 127 ---------------------------------------- lib/Gruntmaster/Data.pm | 102 -------------------------------- 4 files changed, 374 deletions(-) delete mode 100755 gruntmaster-contest delete mode 100755 gruntmaster-job delete mode 100755 gruntmaster-problem delete mode 100644 lib/Gruntmaster/Data.pm diff --git a/gruntmaster-contest b/gruntmaster-contest deleted file mode 100755 index c2608c9..0000000 --- a/gruntmaster-contest +++ /dev/null @@ -1,73 +0,0 @@ -#!/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 diff --git a/gruntmaster-job b/gruntmaster-job deleted file mode 100755 index 7adab69..0000000 --- a/gruntmaster-job +++ /dev/null @@ -1,72 +0,0 @@ -#!/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 diff --git a/gruntmaster-problem b/gruntmaster-problem deleted file mode 100755 index 80aa68d..0000000 --- a/gruntmaster-problem +++ /dev/null @@ -1,127 +0,0 @@ -#!/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 diff --git a/lib/Gruntmaster/Data.pm b/lib/Gruntmaster/Data.pm deleted file mode 100644 index 1b2492c..0000000 --- a/lib/Gruntmaster/Data.pm +++ /dev/null @@ -1,102 +0,0 @@ -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 -- 2.39.2