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