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