4adf80178eb93c868d6b92488916de990ccd63e2
[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon.pm
1 package Gruntmaster::Daemon;
2
3 use 5.014000;
4 use strict;
5 use warnings;
6
7 our $VERSION = '0.001';
8
9 use Gruntmaster::Daemon::Constants qw/ERR/;
10 use Gruntmaster::Daemon::Format qw/mkrun/;
11 use Gruntmaster::Data qw/job_inmeta job_problem problem_meta set_job_daemon set_job_result set_job_result_text set_job_results SUBSCRIBE WAIT_FOR_MESSAGES/;
12 use Gruntmaster::Page::Log;
13
14 use File::Basename qw/fileparse/;
15 use File::Slurp qw/write_file/;
16 use File::Spec::Functions qw/devnull/;
17 use File::Temp qw/tempdir/;
18 use IO::File;
19 use IPC::Open3 qw/open3/;
20 use Sys::Hostname qw/hostname/;
21 use Time::HiRes qw/time/;
22 use Try::Tiny;
23 use YAML::Any qw/LoadFile DumpFile/;
24 use Log::Log4perl qw/get_logger/;
25
26 ##################################################
27
28 sub safe_can_nodie {
29 my ($type, $sub, $name) = @_;
30
31 return unless $name =~ /^\w+$/;
32 no strict 'refs';
33 my $pkg = __PACKAGE__ . "::${type}::${name}";
34 eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@");
35 $pkg->can($sub);
36 }
37
38 sub safe_can {
39 my ($type, $sub, $name) = @_;
40
41 safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
42 }
43
44 sub prepare{
45 my ($name, $format) = @_;
46 my $basename = fileparse $name, qr/\.[^.]*/;
47 get_logger->trace("Preparing file $name...");
48
49 open my $devnull, devnull;
50 open my $errors, '>>compile-error';
51 my $ret = open3 $devnull, $errors, undef, 'gruntmaster-compile', $format => $basename, $name;
52 waitpid $ret, 0;
53 close $devnull;
54 close $errors;
55 die 'Compile error' if $?
56 }
57
58 sub prepare_files{
59 my $meta = shift;
60
61 for my $file (values $meta->{files}) {
62 my ($format, $name, $content) = @{$file}{qw/format name content/};
63
64 $file->{run} = mkrun($format);
65 write_file $name, $content;
66 prepare $name, $format;
67 }
68 }
69
70 sub process{
71 my $job = shift;
72
73 my @results;
74 my @full_results = ();
75 my $meta = {};
76 try {
77 $meta = job_inmeta $job;
78 if (job_problem $job) {
79 my $pbmeta = problem_meta job_problem $job;
80 my %files = %{$meta->{files}};
81 $meta = {%$meta, %$pbmeta};
82 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
83 }
84
85 prepare_files $meta;
86
87 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
88
89 $generator = safe_can Generator => generate => $generator;
90 $runner = safe_can Runner => run => $runner;
91 $judge = safe_can Judge => judge => $judge;
92
93 for my $test (1 .. $testcnt) {
94 my $start_time = time;
95 my $result;
96 try {
97 $generator->($test, $meta);
98 $result = $runner->($test, $meta);
99 } catch {
100 $result = $_;
101 unless (ref $result) {
102 chomp $result;
103 $result = [ERR, $result];
104 }
105 };
106
107 if (ref $result) {
108 get_logger->trace("Test $test result is " . $result->[1]);
109 push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time}
110 } else {
111 get_logger->trace("Test $test result is $result");
112 push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time}
113 }
114 push @results, $result;
115 last if $meta->{judge} eq 'Absolute' && ref $result
116 }
117
118 my %results = $judge->(@results);
119 $meta->{$_} = $results{$_} for keys %results;
120 } catch {
121 s,(.*) at .*,$1,;
122 chomp;
123 $meta->{result} = -1;
124 $meta->{result_text} = $_;
125 };
126
127 get_logger->info("Job result: " . $meta->{result_text});
128 set_job_result $job, $meta->{result};
129 set_job_result_text $job, $meta->{result_text};
130 set_job_results $job, \@full_results if scalar @full_results;
131
132 my $log = $meta->{contest} ? "ct/$meta->{contest}/log" : 'log';
133 PUBLISH gensrc => $job;
134 PUBLISH genpage => "$log/job/$job.html";
135 my $page = ($job + Gruntmaster::Page::Log::PAGE_SIZE - 1) / Gruntmaster::Page::Log::PAGE_SIZE;
136 PUBLISH genpage => "$log/$page.html"
137 }
138
139 sub got_job{
140 my $job = shift;
141 get_logger->debug("Taking job $job...");
142 if (set_job_daemon $job, hostname . ":$$") {
143 get_logger->debug("Succesfully taken job $job");
144 process $job;
145 get_logger->debug("Job $job done");
146 } else {
147 get_logger->debug("Job $job already taken");
148 }
149 }
150
151 sub run{
152 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
153 get_logger->info("gruntmasterd $VERSION started");
154 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
155 SUBSCRIBE jobs => \&got_job;
156 WAIT_FOR_MESSAGES 86400 while 1
157 }
158
159 1;
160 __END__
161 # Below is stub documentation for your module. You'd better edit it!
162
163 =head1 NAME
164
165 Gruntmaster::Daemon - Perl extension for blah blah blah
166
167 =head1 SYNOPSIS
168
169 use Gruntmaster::Daemon;
170 blah blah blah
171
172 =head1 DESCRIPTION
173
174 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
175 author of the extension was negligent enough to leave the stub
176 unedited.
177
178 Blah blah blah.
179
180
181 =head1 SEE ALSO
182
183 Mention other useful documentation such as the documentation of
184 related modules or operating system documentation (such as man pages
185 in UNIX), or any relevant external documentation such as RFCs or
186 standards.
187
188 If you have a mailing list set up for your module, mention it here.
189
190 If you have a web site set up for your module, mention it here.
191
192 =head1 AUTHOR
193
194 Marius Gavrilescu, E<lt>marius@E<gt>
195
196 =head1 COPYRIGHT AND LICENSE
197
198 Copyright (C) 2013 by Marius Gavrilescu
199
200 This library is free software; you can redistribute it and/or modify
201 it under the same terms as Perl itself, either Perl version 5.18.1 or,
202 at your option, any later version of Perl 5 you may have available.
203
204
205 =cut
This page took 0.03004 seconds and 3 git commands to generate.