1 package Gruntmaster
::Daemon
;
7 our $VERSION = '0.001';
9 use Gruntmaster
::Daemon
::Constants qw
/ERR/;
10 use Gruntmaster
::Daemon
::Format qw
/prepare_files/;
11 use Gruntmaster
::Data
;
13 use File
::Basename qw
/fileparse/;
14 use File
::Slurp qw
/write_file/;
15 use File
::Temp qw
/tempdir/;
16 use Sys
::Hostname qw
/hostname/;
17 use Time
::HiRes qw
/time/;
19 use Log
::Log4perl qw
/get_logger/;
21 use constant PAGE_SIZE
=> 10;
23 ##################################################
26 my ($type, $sub, $name) = @_;
28 return unless $name =~ /^\w+$/;
30 my $pkg = __PACKAGE__
. "::${type}::${name}";
31 eval "require $pkg" or get_logger
->warn("Error while requiring $pkg: $@");
36 my ($type, $sub, $name) = @_;
38 safe_can_nodie
@_ or get_logger
->logdie("No such \l$type: '$name'");
45 my @full_results = ();
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
};
60 my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw
/files generator runner judge testcnt/;
62 $generator = safe_can Generator
=> generate
=> $generator;
63 $runner = safe_can Runner
=> run
=> $runner;
64 $judge = safe_can Judge
=> judge
=> $judge;
66 for my $test (1 .. $testcnt) {
67 my $start_time = time;
70 $generator->($test, $meta);
71 $result = $runner->($test, $meta);
74 unless (ref $result) {
76 $result = [ERR
, $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}
84 get_logger
->trace("Test $test result is $result");
85 push @full_results, {id
=> $test, result
=> 0, result_text
=> $result, time => time - $start_time}
87 push @results, $result;
88 last if $meta->{judge
} eq 'Absolute' && ref $result
91 my %results = $judge->(@results);
92 $meta->{$_} = $results{$_} for keys %results;
97 $meta->{result_text
} = $_;
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;
106 my $log = $Gruntmaster::Data
::contest ?
"ct/$Gruntmaster::Data::contest/log" : 'log';
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";
119 $_[0] =~ /^(\w*)\.(\d+)$/;
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");
126 get_logger
->debug("Job $job done");
128 get_logger
->debug("Job $job already taken");
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
142 # Below is stub documentation for your module. You'd better edit it!
146 Gruntmaster::Daemon - Perl extension for blah blah blah
150 use Gruntmaster::Daemon;
155 Stub documentation for Gruntmaster::Daemon, created by h2xs. It looks like the
156 author of the extension was negligent enough to leave the stub
164 Mention other useful documentation such as the documentation of
165 related modules or operating system documentation (such as man pages
166 in UNIX), or any relevant external documentation such as RFCs or
169 If you have a mailing list set up for your module, mention it here.
171 If you have a web site set up for your module, mention it here.
175 Marius Gavrilescu, E<lt>marius@E<gt>
177 =head1 COPYRIGHT AND LICENSE
179 Copyright (C) 2013 by Marius Gavrilescu
181 This library is free software; you can redistribute it and/or modify
182 it under the same terms as Perl itself, either Perl version 5.18.1 or,
183 at your option, any later version of Perl 5 you may have available.
This page took 0.034107 seconds and 5 git commands to generate.