Fix contest job log updating
[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) = @_;
22e9a940 46 our $errors;
ddceb393
MG
47 my $basename = fileparse $name, qr/\.[^.]*/;
48 get_logger->trace("Preparing file $name...");
49
22e9a940
MG
50 $errors .= `gruntmaster-compile $format $basename $name 2>&1`;
51 $errors .= "\n";
ddceb393
MG
52 die 'Compile error' if $?
53}
54
5c5cd38a 55sub prepare_files{
ab436d78 56 my $meta = shift;
5c5cd38a
MG
57
58 for my $file (values $meta->{files}) {
ab436d78 59 my ($format, $name, $content) = @{$file}{qw/format name content/};
5c5cd38a 60
ddceb393 61 $file->{run} = mkrun($format);
ab436d78
MG
62 write_file $name, $content;
63 prepare $name, $format;
5c5cd38a
MG
64 }
65}
66
ab436d78
MG
67sub process{
68 my $job = shift;
5c5cd38a
MG
69
70 my @results;
71 my @full_results = ();
72 my $meta = {};
22e9a940 73 our $errors = '';
5c5cd38a 74 try {
ab436d78
MG
75 $meta = job_inmeta $job;
76 if (job_problem $job) {
77 my $pbmeta = problem_meta job_problem $job;
78 my %files = %{$meta->{files}};
5c5cd38a 79 $meta = {%$meta, %$pbmeta};
ab436d78 80 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
5c5cd38a
MG
81 }
82
ab436d78 83 prepare_files $meta;
22e9a940 84 chomp $errors;
ab436d78 85
5c5cd38a
MG
86 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
87
88 $generator = safe_can Generator => generate => $generator;
89 $runner = safe_can Runner => run => $runner;
90 $judge = safe_can Judge => judge => $judge;
91
5c5cd38a
MG
92 for my $test (1 .. $testcnt) {
93 my $start_time = time;
94 my $result;
95 try {
96 $generator->($test, $meta);
97 $result = $runner->($test, $meta);
98 } catch {
99 $result = $_;
100 unless (ref $result) {
101 chomp $result;
102 $result = [ERR, $result];
103 }
104 };
105
106 if (ref $result) {
107 get_logger->trace("Test $test result is " . $result->[1]);
108 push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time}
109 } else {
110 get_logger->trace("Test $test result is $result");
111 push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time}
112 }
113 push @results, $result;
114 last if $meta->{judge} eq 'Absolute' && ref $result
115 }
116
117 my %results = $judge->(@results);
118 $meta->{$_} = $results{$_} for keys %results;
119 } catch {
120 s,(.*) at .*,$1,;
121 chomp;
122 $meta->{result} = -1;
123 $meta->{result_text} = $_;
124 };
125
5c5cd38a 126 get_logger->info("Job result: " . $meta->{result_text});
ab436d78
MG
127 set_job_result $job, $meta->{result};
128 set_job_result_text $job, $meta->{result_text};
129 set_job_results $job, \@full_results if scalar @full_results;
22e9a940 130 set_job_errors $job, $errors;
ab436d78 131
0e0e340d 132 my $log = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::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{
cfb728e8
MG
144 $_[0] =~ /^(\w*)\.(\d+)$/;
145 my $job = $2;
146 $Gruntmaster::Data::contest = $1 if $1;
147 get_logger->debug("Taking job $job@{[defined $1 ? \" of contest $1\" : '']}...");
ab436d78
MG
148 if (set_job_daemon $job, hostname . ":$$") {
149 get_logger->debug("Succesfully taken job $job");
150 process $job;
151 get_logger->debug("Job $job done");
152 } else {
153 get_logger->debug("Job $job already taken");
154 }
5c5cd38a
MG
155}
156
157sub run{
bd084fbe 158 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
ab436d78 159 get_logger->info("gruntmasterd $VERSION started");
f3ad9692
MG
160 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
161 SUBSCRIBE jobs => \&got_job;
162 WAIT_FOR_MESSAGES 86400 while 1
5c5cd38a
MG
163}
164
1651;
166__END__
167# Below is stub documentation for your module. You'd better edit it!
168
169=head1 NAME
170
171Gruntmaster::Daemon - Perl extension for blah blah blah
172
173=head1 SYNOPSIS
174
175 use Gruntmaster::Daemon;
176 blah blah blah
177
178=head1 DESCRIPTION
179
180Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
181author of the extension was negligent enough to leave the stub
182unedited.
183
184Blah blah blah.
185
186
187=head1 SEE ALSO
188
189Mention other useful documentation such as the documentation of
190related modules or operating system documentation (such as man pages
191in UNIX), or any relevant external documentation such as RFCs or
192standards.
193
194If you have a mailing list set up for your module, mention it here.
195
196If you have a web site set up for your module, mention it here.
197
198=head1 AUTHOR
199
200Marius Gavrilescu, E<lt>marius@E<gt>
201
202=head1 COPYRIGHT AND LICENSE
203
204Copyright (C) 2013 by Marius Gavrilescu
205
206This library is free software; you can redistribute it and/or modify
207it under the same terms as Perl itself, either Perl version 5.18.1 or,
208at your option, any later version of Perl 5 you may have available.
209
210
211=cut
This page took 0.025081 seconds and 4 git commands to generate.