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