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