Regenerate standings and log after job
[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon.pm
CommitLineData
5c5cd38a
MG
1package Gruntmaster::Daemon;
2
3use 5.014000;
4use strict;
5use warnings;
6
7our $VERSION = '0.001';
8
9use Gruntmaster::Daemon::Constants qw/ERR/;
ddceb393 10use Gruntmaster::Daemon::Format qw/mkrun/;
4dc6495c 11use Gruntmaster::Data;
95ea982c 12use Gruntmaster::Page::Log;
5c5cd38a 13
ab436d78
MG
14use File::Basename qw/fileparse/;
15use File::Slurp qw/write_file/;
16use File::Spec::Functions qw/devnull/;
17use File::Temp qw/tempdir/;
5c5cd38a 18use IO::File;
ab436d78 19use IPC::Open3 qw/open3/;
ab436d78 20use Sys::Hostname qw/hostname/;
5c5cd38a
MG
21use Time::HiRes qw/time/;
22use Try::Tiny;
23use YAML::Any qw/LoadFile DumpFile/;
24use Log::Log4perl qw/get_logger/;
25
26##################################################
27
28sub 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
38sub safe_can {
39 my ($type, $sub, $name) = @_;
40
41 safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
42}
43
ddceb393 44sub prepare{
ab436d78 45 my ($name, $format) = @_;
ddceb393
MG
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';
ab436d78 51 my $ret = open3 $devnull, $errors, undef, 'gruntmaster-compile', $format => $basename, $name;
ddceb393
MG
52 waitpid $ret, 0;
53 close $devnull;
54 close $errors;
55 die 'Compile error' if $?
56}
57
5c5cd38a 58sub prepare_files{
ab436d78 59 my $meta = shift;
5c5cd38a
MG
60
61 for my $file (values $meta->{files}) {
ab436d78 62 my ($format, $name, $content) = @{$file}{qw/format name content/};
5c5cd38a 63
ddceb393 64 $file->{run} = mkrun($format);
ab436d78
MG
65 write_file $name, $content;
66 prepare $name, $format;
5c5cd38a
MG
67 }
68}
69
ab436d78
MG
70sub process{
71 my $job = shift;
5c5cd38a
MG
72
73 my @results;
74 my @full_results = ();
75 my $meta = {};
76 try {
ab436d78
MG
77 $meta = job_inmeta $job;
78 if (job_problem $job) {
79 my $pbmeta = problem_meta job_problem $job;
80 my %files = %{$meta->{files}};
5c5cd38a 81 $meta = {%$meta, %$pbmeta};
ab436d78 82 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
5c5cd38a
MG
83 }
84
ab436d78 85 prepare_files $meta;
ab436d78 86
5c5cd38a
MG
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
5c5cd38a
MG
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
5c5cd38a 127 get_logger->info("Job result: " . $meta->{result_text});
ab436d78
MG
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
ab436d78 132 my $log = $meta->{contest} ? "ct/$meta->{contest}/log" : 'log';
95ea982c
MG
133 PUBLISH gensrc => $job;
134 PUBLISH genpage => "$log/job/$job.html";
7ddb70a9 135 PUBLISH genpage => "$log/index.html";
4dc6495c 136 PUBLISH genpage => "$log/st.html";
ab436d78 137 my $page = ($job + Gruntmaster::Page::Log::PAGE_SIZE - 1) / Gruntmaster::Page::Log::PAGE_SIZE;
4dc6495c
MG
138 PUBLISH genpage => "$log/@{[$page - 1]}.html";
139 PUBLISH genpage => "$log/$page.html";
140 PUBLISH genpage => "$log/@{[$page + 1]}.html";
ab436d78
MG
141}
142
143sub got_job{
144 my $job = shift;
145 get_logger->debug("Taking job $job...");
146 if (set_job_daemon $job, hostname . ":$$") {
147 get_logger->debug("Succesfully taken job $job");
148 process $job;
149 get_logger->debug("Job $job done");
150 } else {
151 get_logger->debug("Job $job already taken");
152 }
5c5cd38a
MG
153}
154
155sub run{
bd084fbe 156 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
ab436d78 157 get_logger->info("gruntmasterd $VERSION started");
f3ad9692
MG
158 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
159 SUBSCRIBE jobs => \&got_job;
160 WAIT_FOR_MESSAGES 86400 while 1
5c5cd38a
MG
161}
162
1631;
164__END__
165# Below is stub documentation for your module. You'd better edit it!
166
167=head1 NAME
168
169Gruntmaster::Daemon - Perl extension for blah blah blah
170
171=head1 SYNOPSIS
172
173 use Gruntmaster::Daemon;
174 blah blah blah
175
176=head1 DESCRIPTION
177
178Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
179author of the extension was negligent enough to leave the stub
180unedited.
181
182Blah blah blah.
183
184
185=head1 SEE ALSO
186
187Mention other useful documentation such as the documentation of
188related modules or operating system documentation (such as man pages
189in UNIX), or any relevant external documentation such as RFCs or
190standards.
191
192If you have a mailing list set up for your module, mention it here.
193
194If you have a web site set up for your module, mention it here.
195
196=head1 AUTHOR
197
198Marius Gavrilescu, E<lt>marius@E<gt>
199
200=head1 COPYRIGHT AND LICENSE
201
202Copyright (C) 2013 by Marius Gavrilescu
203
204This library is free software; you can redistribute it and/or modify
205it under the same terms as Perl itself, either Perl version 5.18.1 or,
206at your option, any later version of Perl 5 you may have available.
207
208
209=cut
This page took 0.023963 seconds and 4 git commands to generate.