Regenerate log index after each 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/;
f3ad9692 11use 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/;
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";
ab436d78 136 my $page = ($job + Gruntmaster::Page::Log::PAGE_SIZE - 1) / Gruntmaster::Page::Log::PAGE_SIZE;
95ea982c 137 PUBLISH genpage => "$log/$page.html"
ab436d78
MG
138}
139
140sub got_job{
141 my $job = shift;
142 get_logger->debug("Taking job $job...");
143 if (set_job_daemon $job, hostname . ":$$") {
144 get_logger->debug("Succesfully taken job $job");
145 process $job;
146 get_logger->debug("Job $job done");
147 } else {
148 get_logger->debug("Job $job already taken");
149 }
5c5cd38a
MG
150}
151
152sub run{
bd084fbe 153 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
ab436d78 154 get_logger->info("gruntmasterd $VERSION started");
f3ad9692
MG
155 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
156 SUBSCRIBE jobs => \&got_job;
157 WAIT_FOR_MESSAGES 86400 while 1
5c5cd38a
MG
158}
159
1601;
161__END__
162# Below is stub documentation for your module. You'd better edit it!
163
164=head1 NAME
165
166Gruntmaster::Daemon - Perl extension for blah blah blah
167
168=head1 SYNOPSIS
169
170 use Gruntmaster::Daemon;
171 blah blah blah
172
173=head1 DESCRIPTION
174
175Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
176author of the extension was negligent enough to leave the stub
177unedited.
178
179Blah blah blah.
180
181
182=head1 SEE ALSO
183
184Mention other useful documentation such as the documentation of
185related modules or operating system documentation (such as man pages
186in UNIX), or any relevant external documentation such as RFCs or
187standards.
188
189If you have a mailing list set up for your module, mention it here.
190
191If you have a web site set up for your module, mention it here.
192
193=head1 AUTHOR
194
195Marius Gavrilescu, E<lt>marius@E<gt>
196
197=head1 COPYRIGHT AND LICENSE
198
199Copyright (C) 2013 by Marius Gavrilescu
200
201This library is free software; you can redistribute it and/or modify
202it under the same terms as Perl itself, either Perl version 5.18.1 or,
203at your option, any later version of Perl 5 you may have available.
204
205
206=cut
This page took 0.024532 seconds and 4 git commands to generate.