view release on metacpan or  search on metacpan

lib/App/EvalServerAdvanced/JobManager.pm  view on Meta::CPAN

package App::EvalServerAdvanced::JobManager;

use v5.20;
use strict;
use warnings;
use feature qw(postderef);
no warnings qw(experimental::postderef);

our $VERSION = '0.024';

use Data::Dumper;
use Moo;
use App::EvalServerAdvanced::Config;
use App::EvalServerAdvanced::Log;
use Function::Parameters;
use POSIX qw/dup2 _exit/;
use IO::Handle;

has loop => (is => 'ro');
has workers => (is => 'ro', builder => sub {+{}});
has jobs => (is => 'ro', builder => sub {+{}});

method add_job($eval_obj) {
    my $job_fut = $self->loop->new_future();
    my $prio = $eval_obj->{priority} // "realtime";

    debug "Got job, $prio";
    my $job = {future => $job_fut, eval_obj => $eval_obj};
    push $self->jobs->{$prio}->@*, $job;
    $self->tick(); # start anything if possible
    $job_fut->on_ready(sub {$self->tick()});

    return $job;
}

method run_job($eval_job) {
    my $eval_obj = $eval_job->{eval_obj};
    my $job_future = $eval_job->{future};
    my $out = '';
    my $in = '';

    my ($code_file) = grep {$_->filename eq '__code'} $eval_obj->{files}->@*;
    my $code = $code_file->get_contents;

    my $proc_future;
    my $proc = IO::Async::Process->new(
        code => sub {
            close(STDERR);
            dup2(1,2) or _exit(212); # Setup the C side of things
#            *STDERR = \*STDOUT; # Setup the perl side of things
            *STDERR = IO::Handle->new_from_fd(2, "w"); # setup a new STDERR
            binmode STDOUT, ":encoding(utf8)"; # these really only affect perl subs, but they should also support other encodings
            binmode STDERR, ":encoding(utf8)";
            binmode STDIN, ":encoding(utf8)";

            $SIG{$_} = sub {_exit(1)} for (keys %SIG);

            eval {
                App::EvalServerAdvanced::Sandbox::run_eval($code, $eval_obj->{language}, $eval_obj->{files});
            };
            if ($@) {
                print "$@";
            }

            _exit(0);
        },
        stdout => {into => \$out},
        # TODO these two things need to be handled differently for encoding
        stdin => {from => Encode::encode("utf8", $in)},
        on_finish => sub { my $out_utf8 = Encode::decode("utf8", $out); $job_future->done($out_utf8) unless $job_future->is_ready; delete $self->workers->{$proc_future}; }
    );