view release on metacpan or  search on metacpan

lib/MHFS/Process.pm  view on Meta::CPAN

    return $process;
}

# launch a command process with poll handlers
sub _new_cmd {
    my ($mpa, $prochandlers, $handlesettings) = @_;
    return $mpa->{'class'}->new($mpa->{'cmd'}, $mpa->{'evp'}, $prochandlers, $handlesettings);
}

# launch a command process
sub new_cmd_process {
    my ($class, $evp, $cmd, $context) = @_;
    my $mpa = {'class' => $class, 'evp' => $evp, 'cmd' => $cmd};
    return _new_ex(\&_new_cmd, $mpa, $context);
}

# subset of command process, just need the data on SIGCHLD
sub new_output_process {
    my ($class, $evp, $cmd, $handler) = @_;

    return new_cmd_process($class, $evp, $cmd, {
        'at_exit' => sub {
            my ($context) = @_;
            say 'run handler';
            $handler->($context->{'stdout'}, $context->{'stderr'});
        }
    });
}

sub new_io_process {
    my ($class, $evp, $cmd, $handler, $inputdata) = @_;
    my $ctx = {
        'at_exit' => sub {
            my ($context) = @_;
            say 'run handler';
            $handler->($context->{'stdout'}, $context->{'stderr'});
        }
    };
    if(defined $inputdata) {
        $ctx->{'curbuf'} = $inputdata;
        $ctx->{'input'} = sub {
            say "all written";
            return undef;
        };
    }
    return new_cmd_process($class, $evp, $cmd, $ctx);
}

# launch a process without a new exe with poll handlers
sub _new_child {
    my ($mpa, $prochandlers, $handlesettings) = @_;

    my %self = ('time' => clock_gettime(CLOCK_MONOTONIC), 'evp' => $mpa->{'evp'});
    # inreader/inwriter   is the parent to child data channel
    # outreader/outwriter is the child to parent data channel
    # errreader/errwriter is the child to parent log channel
    pipe(my $inreader, my $inwriter)   or die("pipe failed $!");
    pipe(my $outreader, my $outwriter) or die("pipe failed $!");
    pipe(my $errreader, my $errwriter) or die("pipe failed $!");
    # the childs stderr will be UTF-8 text
    binmode($errreader, ':encoding(UTF-8)');
    my $pid = fork() // do {
        say "failed to fork";
        return undef;
    };
    if($pid == 0) {
        close($inwriter);
        close($outreader);
        close($errreader);
        open(STDIN,  "<&", $inreader) or die("Can't dup \$inreader to STDIN");
        open(STDOUT, ">&", $errwriter) or die("Can't dup \$errwriter to STDOUT");
        open(STDERR, ">&", $errwriter) or die("Can't dup \$errwriter to STDERR");
        $mpa->{'func'}->($outwriter);
        exit 0;
    }
    close($inreader);
    close($outwriter);
    close($errwriter);
    $self{'pid'} = $pid;
    say 'PID '. $pid . ' NEW CHILD';
    _setup_handlers(\%self, $inwriter, $outreader, $errreader, $prochandlers, $handlesettings);
    return bless \%self, $mpa->{'class'};
}

sub cmd_to_sock {
    my ($name, $cmd, $sockfh) = @_;
    if(fork() == 0) {
        open(STDOUT, ">&", $sockfh) or die("Can't dup \$sockfh to STDOUT");
        exec(@$cmd);
        die;
    }
    close($sockfh);
}

# launch a process without a new exe with just sigchld handler
sub new_output_child {
    my ($class, $evp, $func, $handler) = @_;
    my $mpa = {'class' => $class, 'evp' => $evp, 'func' => $func};
    return _new_ex(\&_new_child, $mpa, {
        'at_exit' => sub {
            my ($context) = @_;
            $handler->($context->{'stdout'}, $context->{'stderr'}, $context->{exit_status});
        }
    });
}

sub remove {
    my ($self, $fd) = @_;
    $self->{'evp'}->remove($fd);
    say "poll has " . scalar ( $self->{'evp'}{'poll'}->handles) . " handles";
    foreach my $key (keys %{$self->{'fd'}}) {
        if(defined($self->{'fd'}{$key}{'fd'}) && ($fd == $self->{'fd'}{$key}{'fd'})) {
            $self->{'fd'}{$key} = undef;
            last;
        }
    }
}


sub DESTROY {
    my $self = shift;