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