Save compile errors
[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;
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 our $errors;
47 my $basename = fileparse $name, qr/\.[^.]*/;
48 get_logger->trace("Preparing file $name...");
49
50 $errors .= `gruntmaster-compile $format $basename $name 2>&1`;
51 $errors .= "\n";
52 die 'Compile error' if $?
53 }
54
55 sub prepare_files{
56 my $meta = shift;
57
58 for my $file (values $meta->{files}) {
59 my ($format, $name, $content) = @{$file}{qw/format name content/};
60
61 $file->{run} = mkrun($format);
62 write_file $name, $content;
63 prepare $name, $format;
64 }
65 }
66
67 sub process{
68 my $job = shift;
69
70 my @results;
71 my @full_results = ();
72 my $meta = {};
73 our $errors = '';
74 try {
75 $meta = job_inmeta $job;
76 if (job_problem $job) {
77 my $pbmeta = problem_meta job_problem $job;
78 my %files = %{$meta->{files}};
79 $meta = {%$meta, %$pbmeta};
80 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
81 }
82
83 prepare_files $meta;
84 chomp $errors;
85
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
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
126 get_logger->info("Job result: " . $meta->{result_text});
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;
130 set_job_errors $job, $errors;
131
132 my $log = $meta->{contest} ? "ct/$meta->{contest}/log" : 'log';
133 PUBLISH gensrc => $job;
134 PUBLISH genpage => "$log/job/$job.html";
135 PUBLISH genpage => "$log/index.html";
136 PUBLISH genpage => "$log/st.html";
137 my $page = ($job + Gruntmaster::Page::Log::PAGE_SIZE - 1) / Gruntmaster::Page::Log::PAGE_SIZE;
138 PUBLISH genpage => "$log/@{[$page - 1]}.html";
139 PUBLISH genpage => "$log/$page.html";
140 PUBLISH genpage => "$log/@{[$page + 1]}.html";
141 }
142
143 sub 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 }
153 }
154
155 sub run{
156 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
157 get_logger->info("gruntmasterd $VERSION started");
158 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
159 SUBSCRIBE jobs => \&got_job;
160 WAIT_FOR_MESSAGES 86400 while 1
161 }
162
163 1;
164 __END__
165 # Below is stub documentation for your module. You'd better edit it!
166
167 =head1 NAME
168
169 Gruntmaster::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
178 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
179 author of the extension was negligent enough to leave the stub
180 unedited.
181
182 Blah blah blah.
183
184
185 =head1 SEE ALSO
186
187 Mention other useful documentation such as the documentation of
188 related modules or operating system documentation (such as man pages
189 in UNIX), or any relevant external documentation such as RFCs or
190 standards.
191
192 If you have a mailing list set up for your module, mention it here.
193
194 If you have a web site set up for your module, mention it here.
195
196 =head1 AUTHOR
197
198 Marius Gavrilescu, E<lt>marius@E<gt>
199
200 =head1 COPYRIGHT AND LICENSE
201
202 Copyright (C) 2013 by Marius Gavrilescu
203
204 This library is free software; you can redistribute it and/or modify
205 it under the same terms as Perl itself, either Perl version 5.18.1 or,
206 at your option, any later version of Perl 5 you may have available.
207
208
209 =cut
This page took 0.073142 seconds and 5 git commands to generate.