]>
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 constant FORMAT_EXTENSION => { | |
9 | CPP => 'cpp', | |
10 | }; | |
11 | ||
12 | use Apache2::Access; | |
13 | use Apache2::AuthzCaps qw/hascaps/; | |
14 | use Apache2::RequestRec; | |
15 | use Apache2::RequestIO; | |
16 | use Apache2::Request; | |
17 | use Apache2::Const qw/OK DECLINED/; | |
18 | use Apache2::Log; | |
19 | use Apache2::Upload; | |
20 | ||
21 | use Cwd qw/cwd/; | |
22 | use File::Basename qw/fileparse/; | |
23 | use File::Temp qw/tempdir/; | |
24 | use File::Copy qw/move/; | |
25 | use YAML::Any qw/LoadFile DumpFile/; | |
26 | ||
27 | sub submit{ | |
28 | my $r = shift; | |
29 | chdir $r->dir_config('root'); | |
30 | my $req = Apache2::Request->new($r); | |
31 | my ($problem, $format, $contest) = map {scalar $req->param($_)} 'problem', 'prog_format', 'contest'; | |
32 | my $ext = FORMAT_EXTENSION->{$format}; | |
33 | my $prog = $req->upload('prog'); | |
34 | die if defined $contest && $contest !~ /^\w+$/; | |
35 | ||
36 | if (defined $contest) { | |
37 | my $meta = LoadFile "ct/$contest/meta.yml"; | |
38 | die unless time >= $meta->{start} && time <= $meta->{end} | |
39 | } | |
40 | ||
41 | my $dir = tempdir; | |
42 | $prog->link("$dir/prog.$ext"); | |
43 | DumpFile "$dir/meta.yml", { | |
44 | files => { | |
45 | prog => { | |
46 | format => $format, | |
47 | name => 'prog.cpp', | |
48 | } | |
49 | }, | |
50 | problem => $problem, | |
51 | user => $r->user, | |
52 | date => time, | |
53 | defined $contest ? (contest => $contest) : (), | |
54 | }; | |
55 | ||
56 | my $jobname = int rand 1_000_000_000; | |
57 | $jobname = int rand 1_000_000_000 while -d "jobs/$jobname"; | |
58 | move $dir, "jobs/$jobname" or die $!; | |
59 | ||
60 | $r->print("Job submitted"); | |
61 | OK | |
62 | } | |
63 | ||
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 | ||
85 | 1; | |
86 | __END__ | |
87 | # Below is stub documentation for your module. You'd better edit it! | |
88 | ||
89 | =head1 NAME | |
90 | ||
91 | Gruntmaster::Handlers - Perl extension for blah blah blah | |
92 | ||
93 | =head1 SYNOPSIS | |
94 | ||
95 | use Gruntmaster::Handlers; | |
96 | blah blah blah | |
97 | ||
98 | =head1 DESCRIPTION | |
99 | ||
100 | Stub documentation for Gruntmaster::Handlers, created by h2xs. It looks like the | |
101 | author of the extension was negligent enough to leave the stub | |
102 | unedited. | |
103 | ||
104 | Blah blah blah. | |
105 | ||
106 | ||
107 | =head1 SEE ALSO | |
108 | ||
109 | Mention other useful documentation such as the documentation of | |
110 | related modules or operating system documentation (such as man pages | |
111 | in UNIX), or any relevant external documentation such as RFCs or | |
112 | standards. | |
113 | ||
114 | If you have a mailing list set up for your module, mention it here. | |
115 | ||
116 | If you have a web site set up for your module, mention it here. | |
117 | ||
118 | =head1 AUTHOR | |
119 | ||
120 | Marius Gavrilescu, E<lt>marius@E<gt> | |
121 | ||
122 | =head1 COPYRIGHT AND LICENSE | |
123 | ||
124 | Copyright (C) 2013 by Marius Gavrilescu | |
125 | ||
126 | This library is free software; you can redistribute it and/or modify | |
127 | it under the same terms as Perl itself, either Perl version 5.18.1 or, | |
128 | at your option, any later version of Perl 5 you may have available. | |
129 | ||
130 | ||
131 | =cut |