X-Git-Url: http://git.ieval.ro/?p=gruntmaster-daemon.git;a=blobdiff_plain;f=lib%2FGruntmaster%2FDaemon.pm;h=f2c4a116c0dbcd4d13e47a61be09ee17aef48c60;hp=a9a6d9971a52a863d765996c6ceadfdc5f0ccb25;hb=a722431b0f35babda9d7da134824caf76ad75458;hpb=d6a1ae0d77398b2a7ed967e10e8420ac7d9980e5 diff --git a/lib/Gruntmaster/Daemon.pm b/lib/Gruntmaster/Daemon.pm index a9a6d99..f2c4a11 100644 --- a/lib/Gruntmaster/Daemon.pm +++ b/lib/Gruntmaster/Daemon.pm @@ -26,19 +26,19 @@ my $ua = LWP::UserAgent->new; my @purge_hosts = exists $ENV{PURGE_HOSTS} ? split ' ', $ENV{PURGE_HOSTS} : (); sub safe_can_nodie { - my ($type, $sub, $name) = @_; + my ($type, $sub, $name) = @_; - return unless $name =~ /^\w+$/; - no strict 'refs'; - my $pkg = __PACKAGE__ . "::${type}::${name}"; - eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@"); - $pkg->can($sub); + return unless $name =~ /^\w+$/; + no strict 'refs'; + my $pkg = __PACKAGE__ . "::${type}::${name}"; + eval "require $pkg" or get_logger->warn("Error while requiring $pkg: $@"); + $pkg->can($sub); } sub safe_can { - my ($type, $sub, $name) = @_; + my ($type, $sub, $name) = @_; - safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'"); + safe_can_nodie @_ or get_logger->logdie("No such \l$type: '$name'"); } sub purge { @@ -49,96 +49,96 @@ sub purge { } sub process{ - my $job = shift; - - my @results; - my @full_results = (); - my $meta = {}; - our $errors = ''; - try { - $meta = job_inmeta $job; - if (job_problem $job) { - local $_ = job_problem $job; - my $pbmeta = problem_meta; - my %files = exists $meta->{files} ? %{$meta->{files}} : (); - $meta = { - %$meta, - problem => $_, - (defined problem_generator() ? (generator => problem_generator) : ()), - (defined problem_runner() ? (runner => problem_runner) : ()), - (defined problem_judge() ? (judge => problem_judge) : ()), - (defined problem_testcnt() ? (testcnt => problem_testcnt) : ()), - (defined problem_timeout() ? (timeout => problem_timeout) : ()), - (defined problem_olimit() ? (olimit => problem_olimit) : ()), - %$pbmeta - }; - $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files}; - } + my $job = shift; + + my @results; + my @full_results = (); + my $meta = {}; + our $errors = ''; + try { + $meta = job_inmeta $job; + if (job_problem $job) { + local $_ = job_problem $job; + my $pbmeta = problem_meta; + my %files = exists $meta->{files} ? %{$meta->{files}} : (); + $meta = { + %$meta, + problem => $_, + (defined problem_generator() ? (generator => problem_generator) : ()), + (defined problem_runner() ? (runner => problem_runner) : ()), + (defined problem_judge() ? (judge => problem_judge) : ()), + (defined problem_testcnt() ? (testcnt => problem_testcnt) : ()), + (defined problem_timeout() ? (timeout => problem_timeout) : ()), + (defined problem_olimit() ? (olimit => problem_olimit) : ()), + %$pbmeta + }; + $meta->{files} = {%files, %{$pbmeta->{files}}} if exists $pbmeta->{files}; + } - prepare_files $meta; - chomp $errors; - - my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/; - - $generator = safe_can Generator => generate => $generator; - $runner = safe_can Runner => run => $runner; - $judge = safe_can Judge => judge => $judge; - - for my $test (1 .. $testcnt) { - my $start_time = time; - my $result; - try { - $generator->($test, $meta); - $result = $runner->($test, $meta); - } catch { - $result = $_; - unless (ref $result) { - chomp $result; - $result = [ERR, $result]; + prepare_files $meta; + chomp $errors; + + my ($files, $generator, $runner, $judge, $testcnt) = map { $meta->{$_} or die "Required parameter missing: $_"} qw/files generator runner judge testcnt/; + + $generator = safe_can Generator => generate => $generator; + $runner = safe_can Runner => run => $runner; + $judge = safe_can Judge => judge => $judge; + + for my $test (1 .. $testcnt) { + my $start_time = time; + my $result; + try { + $generator->($test, $meta); + $result = $runner->($test, $meta); + } catch { + $result = $_; + unless (ref $result) { + chomp $result; + $result = [ERR, $result]; + } + }; + + if (ref $result) { + get_logger->trace("Test $test result is " . $result->[1]); + push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time} + } else { + get_logger->trace("Test $test result is $result"); + push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time} + } + push @results, $result; + last if $meta->{judge} eq 'Absolute' && ref $result } - }; - - if (ref $result) { - get_logger->trace("Test $test result is " . $result->[1]); - push @full_results, {id => $test, result => $result->[0], result_text => $result->[1], time => time - $start_time} - } else { - get_logger->trace("Test $test result is $result"); - push @full_results, {id => $test, result => 0, result_text => $result, time => time - $start_time} - } - push @results, $result; - last if $meta->{judge} eq 'Absolute' && ref $result - } - my %results = $judge->(@results); - $meta->{$_} = $results{$_} for keys %results; - } catch { - s,(.*) at .*,$1,; - chomp; - $meta->{result} = -1; - $meta->{result_text} = $_; - }; - - get_logger->info("Job result: " . $meta->{result_text}); - set_job_result $job, $meta->{result}; - set_job_result_text $job, $meta->{result_text}; - set_job_results $job, \@full_results if scalar @full_results; - set_job_errors $job, $errors; - - my $log = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::contest/log" : 'log'; - - PUBLISH gensrc => ($Gruntmaster::Data::contest // '') . ".$job"; - PUBLISH genpage => "$log/job/$job.html"; - PUBLISH genpage => "$log/index.html"; - PUBLISH genpage => "$log/st.html"; - my $page = ($job + PAGE_SIZE - 1) / PAGE_SIZE; - PUBLISH genpage => "$log/@{[$page - 1]}.html"; - PUBLISH genpage => "$log/$page.html"; - PUBLISH genpage => "$log/@{[$page + 1]}.html"; - - purge "/$log/job/$job"; - purge "/$log/"; - purge "/$log/st"; - purge "/$log/$_" for $page - 1, $page, $page + 1; + my %results = $judge->(@results); + $meta->{$_} = $results{$_} for keys %results; + } catch { + s,(.*) at .*,$1,; + chomp; + $meta->{result} = -1; + $meta->{result_text} = $_; + }; + + get_logger->info("Job result: " . $meta->{result_text}); + set_job_result $job, $meta->{result}; + set_job_result_text $job, $meta->{result_text}; + set_job_results $job, \@full_results if scalar @full_results; + set_job_errors $job, $errors; + + my $log = $Gruntmaster::Data::contest ? "ct/$Gruntmaster::Data::contest/log" : 'log'; + + PUBLISH gensrc => ($Gruntmaster::Data::contest // '') . ".$job"; + PUBLISH genpage => "$log/job/$job.html"; + PUBLISH genpage => "$log/index.html"; + PUBLISH genpage => "$log/st.html"; + my $page = ($job + PAGE_SIZE - 1) / PAGE_SIZE; + PUBLISH genpage => "$log/@{[$page - 1]}.html"; + PUBLISH genpage => "$log/$page.html"; + PUBLISH genpage => "$log/@{[$page + 1]}.html"; + + purge "/$log/job/$job"; + purge "/$log/"; + purge "/$log/st"; + purge "/$log/$_" for $page - 1, $page, $page + 1; } sub got_job{ @@ -156,11 +156,11 @@ sub got_job{ } sub run{ - Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf'); - get_logger->info("gruntmasterd $VERSION started"); - chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1; - SUBSCRIBE jobs => \&got_job; - WAIT_FOR_MESSAGES 86400 while 1 + Log::Log4perl->init('/etc/gruntmasterd/gruntmasterd-log.conf'); + get_logger->info("gruntmasterd $VERSION started"); + chdir tempdir 'gruntmasterd.XXXX', CLEANUP => 1, TMPDIR => 1; + SUBSCRIBE jobs => \&got_job; + WAIT_FOR_MESSAGES 86400 while 1 } 1;