From 014ee8a614839ded741f61979d979cdd4f20044c Mon Sep 17 00:00:00 2001 From: Marius Gavrilescu Date: Sat, 1 Feb 2014 14:11:36 +0200 Subject: [PATCH] Copy Data.pm and gruntmaster tools from gruntmaster-page --- MANIFEST | 4 + gruntmaster-contest | 73 ++++++++++++++++ gruntmaster-job | 72 ++++++++++++++++ gruntmaster-problem | 127 ++++++++++++++++++++++++++++ lib/Gruntmaster/Data.pm | 183 ++++++++++++++++++++++------------------ 5 files changed, 376 insertions(+), 83 deletions(-) create mode 100755 gruntmaster-contest create mode 100755 gruntmaster-job create mode 100755 gruntmaster-problem diff --git a/MANIFEST b/MANIFEST index 489150d..37e4261 100644 --- a/MANIFEST +++ b/MANIFEST @@ -2,5 +2,9 @@ Changes Makefile.PL MANIFEST README +gruntmaster-contest +gruntmaster-job +gruntmaster-problem t/Gruntmaster-Data.t lib/Gruntmaster/Data.pm + diff --git a/gruntmaster-contest b/gruntmaster-contest new file mode 100755 index 0000000..c2608c9 --- /dev/null +++ b/gruntmaster-contest @@ -0,0 +1,73 @@ +#!/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 new file mode 100755 index 0000000..7adab69 --- /dev/null +++ b/gruntmaster-job @@ -0,0 +1,72 @@ +#!/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 new file mode 100755 index 0000000..80aa68d --- /dev/null +++ b/gruntmaster-problem @@ -0,0 +1,127 @@ +#!/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 index 48de966..1b2492c 100644 --- a/lib/Gruntmaster/Data.pm +++ b/lib/Gruntmaster/Data.pm @@ -1,85 +1,102 @@ package Gruntmaster::Data; - -use 5.014002; -use strict; +use v5.14; use warnings; - -require Exporter; - -our @ISA = qw(Exporter); - -# Items to export into callers namespace by default. Note: do not export -# names by default without a very good reason. Use EXPORT_OK instead. -# Do not simply export all your public functions/methods/constants. - -# This allows declaration use Gruntmaster::Data ':all'; -# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK -# will save memory. -our %EXPORT_TAGS = ( 'all' => [ qw( - -) ] ); - -our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } ); - -our @EXPORT = qw( - -); - -our $VERSION = '5999.000_001'; -$VERSION = eval $VERSION; # see L - - -# Preloaded methods go here. - -1; -__END__ -# Below is stub documentation for your module. You'd better edit it! - -=head1 NAME - -Gruntmaster::Data - Perl extension for blah blah blah - -=head1 SYNOPSIS - - use Gruntmaster::Data; - blah blah blah - -=head1 DESCRIPTION - -Stub documentation for Gruntmaster::Data, created by h2xs. It looks like the -author of the extension was negligent enough to leave the stub -unedited. - -Blah blah blah. - -=head2 EXPORT - -None by default. - - - -=head1 SEE ALSO - -Mention other useful documentation such as the documentation of -related modules or operating system documentation (such as man pages -in UNIX), or any relevant external documentation such as RFCs or -standards. - -If you have a mailing list set up for your module, mention it here. - -If you have a web site set up for your module, mention it here. - -=head1 AUTHOR - -Marius Gavrilescu, Emarius@E - -=head1 COPYRIGHT AND LICENSE - -Copyright (C) 2014 by Marius Gavrilescu - -This library is free software; you can redistribute it and/or modify -it under the same terms as Perl itself, either Perl version 5.18.2 or, -at your option, any later version of Perl 5 you may have available. - - -=cut +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