]>
Commit | Line | Data |
---|---|---|
1 | package Gruntmaster::Handlers; | |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | our $VERSION = '0.001'; | |
7 | ||
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/; | |
21 | use Gruntmaster::Data qw/contest_start contest_end push_job set_job_inmeta PUBLISH/; | |
22 | use Gruntmaster::Page::Log; | |
23 | ||
24 | sub submit{ | |
25 | my $r = shift; | |
26 | chdir $r->dir_config('root'); | |
27 | my $req = Apache2::Request->new($r); | |
28 | my ($problem, $format, $contest, $private) = map {scalar $req->param($_)} 'problem', 'prog_format', 'contest', 'private'; | |
29 | my $prog; | |
30 | $req->upload('prog')->slurp($prog); | |
31 | die if defined $contest && $contest !~ /^\w+$/ ; | |
32 | die if defined $contest && (time < contest_start $contest || time > contest_end $contest); | |
33 | ||
34 | my $job = push_job ( | |
35 | date => time, | |
36 | problem => $problem, | |
37 | user => $r->user, | |
38 | defined $private ? (private => $private) : (), | |
39 | defined $contest ? (contest => $contest, private => 1) : (), | |
40 | filesize => length $prog, | |
41 | extension => Gruntmaster::Page::Log::FORMAT_EXTENSION->{$format}, | |
42 | ); | |
43 | ||
44 | set_job_inmeta $job, { | |
45 | files => { | |
46 | prog => { | |
47 | format => $format, | |
48 | name => 'prog.' . Gruntmaster::Page::Log::FORMAT_EXTENSION->{$format}, | |
49 | content => $prog, | |
50 | } | |
51 | } | |
52 | }; | |
53 | ||
54 | PUBLISH 'jobs', $job; | |
55 | $r->print("Job submitted"); | |
56 | OK | |
57 | } | |
58 | ||
59 | =begin comment | |
60 | ||
61 | sub private{ | |
62 | my $r = shift; | |
63 | my $dir = (fileparse $r->uri)[1]; | |
64 | my $user = $r->user; | |
65 | chdir $r->dir_config('root') . $dir; | |
66 | ||
67 | for my $requirement (map { $_->{requirement} } @{$r->requires}) { | |
68 | my ($command, @args) = split ' ', $requirement; | |
69 | ||
70 | given ($command){ | |
71 | when('admin-if-private'){ | |
72 | my $meta = LoadFile 'meta.yml'; | |
73 | return OK if !$meta->{private} || ($r->user && hascaps $r->user, 'gmadm') | |
74 | } | |
75 | ||
76 | } | |
77 | } | |
78 | ||
79 | DECLINED | |
80 | } | |
81 | ||
82 | =end comment | |
83 | ||
84 | =cut | |
85 | ||
86 | 1; | |
87 | __END__ | |
88 | # Below is stub documentation for your module. You'd better edit it! | |
89 | ||
90 | =head1 NAME | |
91 | ||
92 | Gruntmaster::Handlers - Perl extension for blah blah blah | |
93 | ||
94 | =head1 SYNOPSIS | |
95 | ||
96 | use Gruntmaster::Handlers; | |
97 | blah blah blah | |
98 | ||
99 | =head1 DESCRIPTION | |
100 | ||
101 | Stub documentation for Gruntmaster::Handlers, created by h2xs. It looks like the | |
102 | author of the extension was negligent enough to leave the stub | |
103 | unedited. | |
104 | ||
105 | Blah blah blah. | |
106 | ||
107 | ||
108 | =head1 SEE ALSO | |
109 | ||
110 | Mention other useful documentation such as the documentation of | |
111 | related modules or operating system documentation (such as man pages | |
112 | in UNIX), or any relevant external documentation such as RFCs or | |
113 | standards. | |
114 | ||
115 | If you have a mailing list set up for your module, mention it here. | |
116 | ||
117 | If you have a web site set up for your module, mention it here. | |
118 | ||
119 | =head1 AUTHOR | |
120 | ||
121 | Marius Gavrilescu, E<lt>marius@E<gt> | |
122 | ||
123 | =head1 COPYRIGHT AND LICENSE | |
124 | ||
125 | Copyright (C) 2013 by Marius Gavrilescu | |
126 | ||
127 | This library is free software; you can redistribute it and/or modify | |
128 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
129 | at your option, any later version of Perl 5 you may have available. | |
130 | ||
131 | ||
132 | =cut |