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