1 package Gruntmaster
::Handlers
;
6 our $VERSION = '0.001';
9 use Apache2
::AuthzCaps qw
/hascaps/;
10 use Apache2
::RequestRec
;
11 use Apache2
::RequestIO
;
13 use Apache2
::Const qw
/OK DECLINED/;
18 use File
::Basename qw
/fileparse/;
19 use File
::Temp qw
/tempdir/;
20 use File
::Copy qw
/move/;
21 use Gruntmaster
::Data qw
/contest_start contest_end push_job set_job_inmeta/;
22 use Gruntmaster
::Page
::Log
;
25 my $redis = Redis
->new;
29 chdir $r->dir_config('root');
30 my $req = Apache2
::Request
->new($r);
31 my ($problem, $format, $contest, $private) = map {scalar $req->param($_)} 'problem', 'prog_format', 'contest', 'private';
33 $req->upload('prog')->slurp($prog);
34 die if defined $contest && $contest !~ /^\w+$/ ;
35 die if defined $contest && (time < contest_start
$contest || time > contest_end
$contest);
41 defined $private ?
(private
=> $private) : (),
42 defined $contest ?
(contest
=> $contest, private
=> 1) : (),
43 filesize
=> length $prog,
44 extension
=> Gruntmaster
::Page
::Log
::FORMAT_EXTENSION
->{$format},
47 set_job_inmeta
$job, {
51 name
=> 'prog.' . Gruntmaster
::Page
::Log
::FORMAT_EXTENSION
->{$format},
57 $redis->publish('jobs', $job);
58 $r->print("Job submitted");
66 my $dir = (fileparse $r->uri)[1];
68 chdir $r->dir_config('root') . $dir;
70 for my $requirement (map { $_->{requirement} } @{$r->requires}) {
71 my ($command, @args) = split ' ', $requirement;
74 when('admin-if-private'){
75 my $meta = LoadFile 'meta.yml';
76 return OK if !$meta->{private} || ($r->user && hascaps $r->user, 'gmadm')
91 # Below is stub documentation for your module. You'd better edit it!
95 Gruntmaster::Handlers - Perl extension for blah blah blah
99 use Gruntmaster::Handlers;
104 Stub documentation for Gruntmaster::Handlers, created by h2xs. It looks like the
105 author of the extension was negligent enough to leave the stub
113 Mention other useful documentation such as the documentation of
114 related modules or operating system documentation (such as man pages
115 in UNIX), or any relevant external documentation such as RFCs or
118 If you have a mailing list set up for your module, mention it here.
120 If you have a web site set up for your module, mention it here.
124 Marius Gavrilescu, E<lt>marius@E<gt>
126 =head1 COPYRIGHT AND LICENSE
128 Copyright (C) 2013 by Marius Gavrilescu
130 This library is free software; you can redistribute it and/or modify
131 it under the same terms as Perl itself, either Perl version 5.18.1 or,
132 at your option, any later version of Perl 5 you may have available.
This page took 0.025378 seconds and 4 git commands to generate.