]>
Commit | Line | Data |
---|---|---|
9f02ff25 MG |
1 | package Gruntmaster::Handlers; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | our $VERSION = '0.001'; | |
7 | ||
9f02ff25 MG |
8 | use Apache2::Access; |
9 | use Apache2::AuthzCaps qw/hascaps/; | |
10 | use Apache2::RequestRec; | |
11 | use Apache2::RequestIO; | |
12 | use Apache2::Request; | |
13 | use Apache2::Const qw/OK DECLINED/; | |
14 | use Apache2::Log; | |
15 | use Apache2::Upload; | |
16 | ||
17 | use Cwd qw/cwd/; | |
18 | use File::Basename qw/fileparse/; | |
19 | use File::Temp qw/tempdir/; | |
20 | use File::Copy qw/move/; | |
5855b3bd MG |
21 | use Gruntmaster::Data qw/contest_start contest_end push_job set_job_inmeta/; |
22 | use Gruntmaster::Page::Log; | |
23 | use Redis; | |
24 | ||
25 | my $redis = Redis->new; | |
9f02ff25 MG |
26 | |
27 | sub submit{ | |
28 | my $r = shift; | |
29 | chdir $r->dir_config('root'); | |
30 | my $req = Apache2::Request->new($r); | |
5855b3bd MG |
31 | my ($problem, $format, $contest, $private) = map {scalar $req->param($_)} 'problem', 'prog_format', 'contest', 'private'; |
32 | my $prog; | |
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); | |
36 | ||
37 | my $job = push_job ( | |
38 | date => time, | |
39 | problem => $problem, | |
40 | user => $r->user, | |
41 | defined $private ? (private => $private) : (), | |
42 | defined $contest ? (contest => $contest, private => 1) : (), | |
43 | filesize => length $prog, | |
44 | extension => Gruntmaster::Page::Log::FORMAT_EXTENSION->{$format}, | |
45 | ); | |
46 | ||
47 | set_job_inmeta $job, { | |
48 | files => { | |
49 | prog => { | |
50 | format => $format, | |
51 | name => 'prog.' . Gruntmaster::Page::Log::FORMAT_EXTENSION->{$format}, | |
52 | content => $prog, | |
53 | } | |
9f02ff25 | 54 | } |
9f02ff25 MG |
55 | }; |
56 | ||
5855b3bd | 57 | $redis->publish('jobs', $job); |
9f02ff25 MG |
58 | $r->print("Job submitted"); |
59 | OK | |
60 | } | |
61 | ||
5855b3bd MG |
62 | =begin comment |
63 | ||
9f02ff25 MG |
64 | sub private{ |
65 | my $r = shift; | |
66 | my $dir = (fileparse $r->uri)[1]; | |
67 | my $user = $r->user; | |
68 | chdir $r->dir_config('root') . $dir; | |
69 | ||
70 | for my $requirement (map { $_->{requirement} } @{$r->requires}) { | |
71 | my ($command, @args) = split ' ', $requirement; | |
72 | ||
73 | given ($command){ | |
74 | when('admin-if-private'){ | |
75 | my $meta = LoadFile 'meta.yml'; | |
76 | return OK if !$meta->{private} || ($r->user && hascaps $r->user, 'gmadm') | |
77 | } | |
78 | ||
79 | } | |
80 | } | |
81 | ||
82 | DECLINED | |
83 | } | |
84 | ||
5855b3bd MG |
85 | =end comment |
86 | ||
87 | =cut | |
88 | ||
9f02ff25 MG |
89 | 1; |
90 | __END__ | |
91 | # Below is stub documentation for your module. You'd better edit it! | |
92 | ||
93 | =head1 NAME | |
94 | ||
95 | Gruntmaster::Handlers - Perl extension for blah blah blah | |
96 | ||
97 | =head1 SYNOPSIS | |
98 | ||
99 | use Gruntmaster::Handlers; | |
100 | blah blah blah | |
101 | ||
102 | =head1 DESCRIPTION | |
103 | ||
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 | |
106 | unedited. | |
107 | ||
108 | Blah blah blah. | |
109 | ||
110 | ||
111 | =head1 SEE ALSO | |
112 | ||
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 | |
116 | standards. | |
117 | ||
118 | If you have a mailing list set up for your module, mention it here. | |
119 | ||
120 | If you have a web site set up for your module, mention it here. | |
121 | ||
122 | =head1 AUTHOR | |
123 | ||
124 | Marius Gavrilescu, E<lt>marius@E<gt> | |
125 | ||
126 | =head1 COPYRIGHT AND LICENSE | |
127 | ||
128 | Copyright (C) 2013 by Marius Gavrilescu | |
129 | ||
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. | |
133 | ||
134 | ||
135 | =cut |