lib/Gruntmaster/Daemon.pm

   1 package Gruntmaster::Daemon;
   2
   3 use 5.014000;
   4 use strict;
   5 use warnings;
   6
   7 our $VERSION = '0.001';
   8
   9 use Gruntmaster::Daemon::Constants qw/ERR/;
  10 use Gruntmaster::Daemon::Format qw/prepare_files/;
  11 use Gruntmaster::Data;
  12
  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/;
  18 use Try::Tiny;
  19 use Log::Log4perl qw/get_logger/;
  20
  21 use constant PAGE_SIZE => 10;
  22
  23 ##################################################
  24
  25 sub 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
  35 sub safe_can {
  36   my ($type, $sub, $name) = @_;
  37
  38   safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'");
  39 }
  40
  41 sub 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
 118 sub 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
 132 sub 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
 140 1;
 141 __END__
 142 # Below is stub documentation for your module. You'd better edit it!
 143
 144 =head1 NAME
 145
 146 Gruntmaster::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
 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
 157 unedited.
 158
 159 Blah blah blah.
 160
 161
 162 =head1 SEE ALSO
 163
 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
 167 standards.
 168
 169 If you have a mailing list set up for your module, mention it here.
 170
 171 If you have a web site set up for your module, mention it here.
 172
 173 =head1 AUTHOR
 174
 175 Marius Gavrilescu, E<lt>marius@E<gt>
 176
 177 =head1 COPYRIGHT AND LICENSE
 178
 179 Copyright (C) 2013 by Marius Gavrilescu
 180
 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.
 184
 185
 186 =cut