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