c3ee5914c5cd5244bfe28ac5d38aefbd7bf0c596
[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 = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::contest/log" : 'log';
133 PUBLISH gensrc => "$Gruntmaster::Data::contest.$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 $_[0] =~ /^(\w*)\.(\d+)$/;
145 my $job = $2;
146 local $Gruntmaster::Data::contest = $1 if $1;
147 get_logger->debug("Taking job $job@{[defined $1 ? \" of contest $1\" : '']}...");
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 }
155 }
156
157 sub run{
158 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
159 get_logger->info("gruntmasterd $VERSION started");
160 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
161 SUBSCRIBE jobs => \&got_job;
162 WAIT_FOR_MESSAGES 86400 while 1
163 }
164
165 1;
166 __END__
167 # Below is stub documentation for your module. You'd better edit it!
168
169 =head1 NAME
170
171 Gruntmaster::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
180 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
181 author of the extension was negligent enough to leave the stub
182 unedited.
183
184 Blah blah blah.
185
186
187 =head1 SEE ALSO
188
189 Mention other useful documentation such as the documentation of
190 related modules or operating system documentation (such as man pages
191 in UNIX), or any relevant external documentation such as RFCs or
192 standards.
193
194 If you have a mailing list set up for your module, mention it here.
195
196 If you have a web site set up for your module, mention it here.
197
198 =head1 AUTHOR
199
200 Marius Gavrilescu, E<lt>marius@E<gt>
201
202 =head1 COPYRIGHT AND LICENSE
203
204 Copyright (C) 2013 by Marius Gavrilescu
205
206 This library is free software; you can redistribute it and/or modify
207 it under the same terms as Perl itself, either Perl version 5.18.1 or,
208 at your option, any later version of Perl 5 you may have available.
209
210
211 =cut
This page took 0.036795 seconds and 3 git commands to generate.