Move prepare and prepare_files to Format.pm
[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/;
ad77b7d3 10use Gruntmaster::Daemon::Format qw/prepare_files/;
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
ab436d78
MG
41sub process{
42 my $job = shift;
5c5cd38a
MG
43
44 my @results;
45 my @full_results = ();
46 my $meta = {};
22e9a940 47 our $errors = '';
5c5cd38a 48 try {
ab436d78
MG
49 $meta = job_inmeta $job;
50 if (job_problem $job) {
51 my $pbmeta = problem_meta job_problem $job;
adb44605 52 my %files = exists $meta->{files} ? %{$meta->{files}} : ();
5c5cd38a 53 $meta = {%$meta, %$pbmeta};
ab436d78 54 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
5c5cd38a
MG
55 }
56
ab436d78 57 prepare_files $meta;
22e9a940 58 chomp $errors;
ab436d78 59
5c5cd38a
MG
60 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/;
61
62 $generator = safe_can Generator => generate => $generator;
63 $runner = safe_can Runner => run => $runner;
64 $judge = safe_can Judge => judge => $judge;
65
5c5cd38a
MG
66 for my $test (1 .. $testcnt) {
67 my $start_time = time;
68 my $result;
69 try {
70 $generator->($test, $meta);
71 $result = $runner->($test, $meta);
72 } catch {
73 $result = $_;
74 unless (ref $result) {
75 chomp $result;
76 $result = [ERR, $result];
77 }
78 };
79
80 if (ref $result) {
81 get_logger->trace("Test $test result is " . $result->[1]);
82 push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time}
83 } else {
84 get_logger->trace("Test $test result is $result");
85 push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time}
86 }
87 push @results, $result;
88 last if $meta->{judge} eq 'Absolute' && ref $result
89 }
90
91 my %results = $judge->(@results);
92 $meta->{$_} = $results{$_} for keys %results;
93 } catch {
94 s,(.*) at .*,$1,;
95 chomp;
96 $meta->{result} = -1;
97 $meta->{result_text} = $_;
98 };
99
5c5cd38a 100 get_logger->info("Job result: " . $meta->{result_text});
ab436d78
MG
101 set_job_result $job, $meta->{result};
102 set_job_result_text $job, $meta->{result_text};
103 set_job_results $job, \@full_results if scalar @full_results;
22e9a940 104 set_job_errors $job, $errors;
ab436d78 105
0e0e340d 106 my $log = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::contest/log" : 'log';
adb44605
MG
107
108 PUBLISH gensrc => ($Gruntmaster::Data::contest // '') . ".$job";
95ea982c 109 PUBLISH genpage => "$log/job/$job.html";
7ddb70a9 110 PUBLISH genpage => "$log/index.html";
4dc6495c 111 PUBLISH genpage => "$log/st.html";
adb44605 112 my $page = ($job + PAGE_SIZE - 1) / PAGE_SIZE;
4dc6495c
MG
113 PUBLISH genpage => "$log/@{[$page - 1]}.html";
114 PUBLISH genpage => "$log/$page.html";
115 PUBLISH genpage => "$log/@{[$page + 1]}.html";
ab436d78
MG
116}
117
118sub got_job{
cfb728e8
MG
119 $_[0] =~ /^(\w*)\.(\d+)$/;
120 my $job = $2;
0890dd25 121 local $Gruntmaster::Data::contest = $1 if $1;
cfb728e8 122 get_logger->debug("Taking job $job@{[defined $1 ? \" of contest $1\" : '']}...");
ab436d78
MG
123 if (set_job_daemon $job, hostname . ":$$") {
124 get_logger->debug("Succesfully taken job $job");
125 process $job;
126 get_logger->debug("Job $job done");
127 } else {
128 get_logger->debug("Job $job already taken");
129 }
5c5cd38a
MG
130}
131
132sub run{
bd084fbe 133 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
ab436d78 134 get_logger->info("gruntmasterd $VERSION started");
f3ad9692
MG
135 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
136 SUBSCRIBE jobs => \&got_job;
137 WAIT_FOR_MESSAGES 86400 while 1
5c5cd38a
MG
138}
139
1401;
141__END__
142# Below is stub documentation for your module. You'd better edit it!
143
144=head1 NAME
145
146Gruntmaster::Daemon - Perl extension for blah blah blah
147
148=head1 SYNOPSIS
149
150 use Gruntmaster::Daemon;
151 blah blah blah
152
153=head1 DESCRIPTION
154
155Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
156author of the extension was negligent enough to leave the stub
157unedited.
158
159Blah blah blah.
160
161
162=head1 SEE ALSO
163
164Mention other useful documentation such as the documentation of
165related modules or operating system documentation (such as man pages
166in UNIX), or any relevant external documentation such as RFCs or
167standards.
168
169If you have a mailing list set up for your module, mention it here.
170
171If you have a web site set up for your module, mention it here.
172
173=head1 AUTHOR
174
175Marius Gavrilescu, E<lt>marius@E<gt>
176
177=head1 COPYRIGHT AND LICENSE
178
179Copyright (C) 2013 by Marius Gavrilescu
180
181This library is free software; you can redistribute it and/or modify
182it under the same terms as Perl itself, either Perl version 5.18.1 or,
183at your option, any later version of Perl 5 you may have available.
184
185
186=cut
This page took 0.021184 seconds and 4 git commands to generate.