Move prepare and prepare_files to Format.pm
[gruntmaster-daemon.git] / lib / Gruntmaster / Daemon.pm
... / ...
CommitLineData
1package Gruntmaster::Daemon;
2
3use 5.014000;
4use strict;
5use warnings;
6
7our $VERSION = '0.001';
8
9use Gruntmaster::Daemon::Constants qw/ERR/;
10use Gruntmaster::Daemon::Format qw/prepare_files/;
11use Gruntmaster::Data;
12
13use File::Basename qw/fileparse/;
14use File::Slurp qw/write_file/;
15use File::Temp qw/tempdir/;
16use Sys::Hostname qw/hostname/;
17use Time::HiRes qw/time/;
18use Try::Tiny;
19use Log::Log4perl qw/get_logger/;
20
21use constant PAGE_SIZE => 10;
22
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
41sub process{
42 my $job = shift;
43
44 my @results;
45 my @full_results = ();
46 my $meta = {};
47 our $errors = '';
48 try {
49 $meta = job_inmeta $job;
50 if (job_problem $job) {
51 my $pbmeta = problem_meta job_problem $job;
52 my %files = exists $meta->{files} ? %{$meta->{files}} : ();
53 $meta = {%$meta, %$pbmeta};
54 $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files};
55 }
56
57 prepare_files $meta;
58 chomp $errors;
59
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
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
100 get_logger->info("Job result: " . $meta->{result_text});
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;
104 set_job_errors $job, $errors;
105
106 my $log = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::contest/log" : 'log';
107
108 PUBLISH gensrc => ($Gruntmaster::Data::contest // '') . ".$job";
109 PUBLISH genpage => "$log/job/$job.html";
110 PUBLISH genpage => "$log/index.html";
111 PUBLISH genpage => "$log/st.html";
112 my $page = ($job + PAGE_SIZE - 1) / PAGE_SIZE;
113 PUBLISH genpage => "$log/@{[$page - 1]}.html";
114 PUBLISH genpage => "$log/$page.html";
115 PUBLISH genpage => "$log/@{[$page + 1]}.html";
116}
117
118sub got_job{
119 $_[0] =~ /^(\w*)\.(\d+)$/;
120 my $job = $2;
121 local $Gruntmaster::Data::contest = $1 if $1;
122 get_logger->debug("Taking job $job@{[defined $1 ? \" of contest $1\" : '']}...");
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 }
130}
131
132sub run{
133 Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf');
134 get_logger->info("gruntmasterd $VERSION started");
135 chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1;
136 SUBSCRIBE jobs => \&got_job;
137 WAIT_FOR_MESSAGES 86400 while 1
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.009642 seconds and 4 git commands to generate.