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