当 Perl 中发生警报时，我应该如何清理挂起的孙进程？

我有一个并行自动化脚本，需要调用许多其他脚本，其中一些脚本挂起，因为它们（错误地）等待标准输入或等待各种其他不会发生的事情。这没什么大不了的，因为我抓住那些alarm http://perldoc.perl.org/functions/alarm.html。诀窍是在子进程关闭时关闭那些挂起的孙进程。我想到了各种咒语SIGCHLD、等待和进程组可以做到这一点，但它们都会阻塞，并且孙子不会被收获。

我的解决方案虽然有效，但似乎不是正确的解决方案。我目前对 Windows 解决方案还不是特别感兴趣，但我最终也会需要它。我的只适用于 Unix，目前还好。

我编写了一个小脚本，它获取同时运行的并行子进程的数量和分叉的总数：

 $ fork_bomb <parallel jobs> <number of forks>

 $ fork_bomb 8 500

这可能会在几分钟内达到每个用户进程的限制。我发现的许多解决方案只是告诉您增加每个用户的进程限制，但我需要它运行大约 300,000 次，所以这是行不通的。同样，重新执行等清除进程表的建议也不是我所需要的。我想真正解决问题，而不是用胶带包裹它。

我爬行进程表寻找子进程并在中单独关闭挂起的进程SIGALRMhandler，它需要终止，因为此后其余的实际代码没有成功的希望。从性能的角度来看，对进程表的复杂爬行并不会打扰我，但我不介意不这样做：

use Parallel::ForkManager;
use Proc::ProcessTable;

my $pm = Parallel::ForkManager->new( $ARGV[0] );

my $alarm_sub = sub {
        kill 9,
            map  { $_->{pid} }
            grep { $_->{ppid} == $$ }
            @{ Proc::ProcessTable->new->table }; 

        die "Alarm rang for $$!\n";
        };

foreach ( 0 .. $ARGV[1] ) 
    {
    print ".";
    print "\n" unless $count++ % 50;

    my $pid = $pm->start and next; 

    local $SIG{ALRM} = $alarm_sub;

    eval {
        alarm( 2 );
        system "$^X -le '<STDIN>'"; # this will hang
        alarm( 0 );
        };

    $pm->finish;
    }

如果你想用完进程，请取出kill http://perldoc.perl.org/functions/kill.html.

我认为设置一个进程组会起作用，这样我就可以一起杀死所有东西，但这会阻止：

my $alarm_sub = sub {
        kill 9, -$$;    # blocks here
        die "Alarm rang for $$!\n";
        };

foreach ( 0 .. $ARGV[1] ) 
    {
    print ".";
    print "\n" unless $count++ % 50;

    my $pid = $pm->start and next; 
    setpgrp(0, 0);

    local $SIG{ALRM} = $alarm_sub;

    eval {
        alarm( 2 );
        system "$^X -le '<STDIN>'"; # this will hang
        alarm( 0 );
        };

    $pm->finish;
    }

同样的事情与POSIX http://perldoc.perl.org/POSIX.html's setsid也不起作用，而且我认为这实际上以不同的方式破坏了事情，因为我并没有真正将其恶魔化。

奇怪的是，并行::ForkManager http://search.cpan.org/dist/Parallel-ForkManager's run_on_finish对于相同的清理代码来说发生得太晚了：此时孙子进程显然已经与子进程解除关联。

我已经读过这个问题好几次了，我想我已经明白你的意思了 正在努力做。你有一个控制脚本。这个脚本产生 孩子们去做一些事情，这些孩子会产生孙子 真正做这项工作。问题是孙子可以 太慢了（等待 STDIN，或者其他什么），你想杀死它们。 此外，如果有一个缓慢的孙子，您想要整个 孩子死（如果可能的话，杀死其他孙子）。

所以，我尝试通过两种方式实现这一点。第一个是让 父进程在一个新的 UNIX 会话中生成一个子进程，为几个进程设置一个计时器 秒，并在计时器关闭时终止整个子会话。 这使得父母既要对孩子负责，也要对孩子负责。 孙子们。它也没有正常工作。

下一个策略是让父进程生成子进程，然后 让孩子负责管理孙子。它会 为每个孙子设置一个计时器，如果进程没有设置则终止它 过期时间退出。这很好用，所以这是代码。

我们将使用 EV 来管理子项和计时器，并使用 AnyEvent 来管理 API。 （您可以尝试另一个 AnyEvent 事件循环，例如 Event 或 POE。 但我知道 EV 正确处理了孩子退出的情况 在你告诉循环监视它之前，这消除了恼人的竞争 其他循环容易受到影响的条件。）

#!/usr/bin/env perl

use strict;
use warnings;
use feature ':5.10';

use AnyEvent;
use EV; # you need EV for the best child-handling abilities

我们需要跟踪儿童观察者：

# active child watchers
my %children;

然后我们需要编写一个函数来启动子进程。这些事 父母生成的东西称为孩子，而孩子的东西 产生的称为工作。

sub start_child($$@) {
    my ($on_success, $on_error, @jobs) = @_;

参数是子进程完成时调用的回调 成功（意味着它的工作也成功），当 孩子没有成功完成，然后是一个coderef列表 要运行的作业。

在这个函数中，我们需要fork。在父级中，我们设置一个子级 观察者监视孩子：

    if(my $pid = fork){ # parent
        # monitor the child process, inform our callback of error or success
        say "$$: Starting child process $pid";
        $children{$pid} = AnyEvent->child( pid => $pid, cb => sub {
            my ($pid, $status) = @_;
            delete $children{$pid};

            say "$$: Child $pid exited with status $status";
            if($status == 0){
                $on_success->($pid);
            }
            else {
                $on_error->($pid);
            }
        });
    }

在孩子身上，我们实际上负责工作。这涉及到一点点 不过，设置。

首先，我们忘记了父母的孩子观察者，因为它不会使 让孩子知道其兄弟姐妹退出的情况。 （叉子是 有趣，因为你继承了父级的所有状态，即使 完全没有意义。）

    else { # child
        # kill the inherited child watchers
        %children = ();
        my %timers;

我们还需要知道所有工作何时完成，以及是否完成 他们都很成功。我们使用计数条件变量来 确定一切都已退出的时间。我们在启动时递增，并且 退出时递减，当计数为 0 时，我们知道一切都完成了。

我还保留一个布尔值来指示错误状态。如果一个进程 以非零状态退出，错误变为 1。否则，它保持 0。 您可能想要保留比这更多的状态:)

        # then start the kids
        my $done = AnyEvent->condvar;
        my $error = 0;

        $done->begin;

（我们也从 1 开始计数，这样如果有 0 个工作，我们的流程 仍然退出。）

现在我们需要为每个作业分叉并运行该作业。在父辈中，我们 做几件事。我们增加条件变量。我们设置一个计时器来杀死 孩子如果太慢了。我们设置了一个儿童观察者，这样我们就可以 了解作业的退出状态。

    for my $job (@jobs) {
            if(my $pid = fork){
                say "[c] $$: starting job $job in $pid";
                $done->begin;

                # this is the timer that will kill the slow children
                $timers{$pid} = AnyEvent->timer( after => 3, interval => 0, cb => sub {
                    delete $timers{$pid};

                    say "[c] $$: Killing $pid: too slow";
                    kill 9, $pid;
                });

                # this monitors the children and cancels the timer if
                # it exits soon enough
                $children{$pid} = AnyEvent->child( pid => $pid, cb => sub {
                    my ($pid, $status) = @_;
                    delete $timers{$pid};
                    delete $children{$pid};

                    say "[c] [j] $$: job $pid exited with status $status";
                    $error ||= ($status != 0);
                    $done->end;
                });
            }

使用定时器比闹钟更容易一些，因为它携带 与它声明。每个计时器都知道要杀死哪个进程，这很容易 当进程成功退出时取消计时器——我们只是 从哈希中删除它。

那是（孩子的）父母。孩子（孩子的；或 工作）非常简单：

            else {
                # run kid
                $job->();
                exit 0; # just in case
            }

如果您愿意，也可以在此处关闭标准输入。

现在，在所有进程都生成之后，我们等待它们 全部通过等待 condvar 退出。事件循环将监视 孩子和计时器，为我们做正确的事：

        } # this is the end of the for @jobs loop
        $done->end;

        # block until all children have exited
        $done->recv;

然后，当所有孩子都退出后，我们就可以进行任何清理工作 我们想要的工作，例如：

        if($error){
            say "[c] $$: One of your children died.";
            exit 1;
        }
        else {
            say "[c] $$: All jobs completed successfully.";
            exit 0;
        }
    } # end of "else { # child"
} # end of start_child

好的，这就是孩子和孙子/工作。现在我们只需要写 父母，这要容易得多。

像孩子一样，我们将使用计数 condvar 来等待我们的 孩子们。

# main program
my $all_done = AnyEvent->condvar;

我们需要做一些工作。这是一个总是成功的，并且 如果你按下回车键就会成功，但如果你按下回车键就会失败 就让它被定时器杀死吧：

my $good_grandchild = sub {
    exit 0;
};

my $bad_grandchild = sub {
    my $line = <STDIN>;
    exit 0;
};

那么我们只需要启动子作业即可。如果你还记得方法 回到顶部start_child，需要两次回调，一个错误 回调，以及成功回调。我们将进行设置；错误 回调将打印“not ok”并递减 condvar，并且 成功回调将打印“ok”并执行相同的操作。很简单。

my $ok  = sub { $all_done->end; say "$$: $_[0] ok" };
my $nok = sub { $all_done->end; say "$$: $_[0] not ok" };

然后我们就可以开始生一群有更多孙子的孩子 工作：

say "starting...";

$all_done->begin for 1..4;
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $good_grandchild);
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $bad_grandchild);
start_child $ok, $nok, ($bad_grandchild, $bad_grandchild, $bad_grandchild);
start_child $ok, $nok, ($good_grandchild, $good_grandchild, $good_grandchild, $good_grandchild);

其中两个将超时，另外两个将成功。如果你按回车键 不过，当他们在跑步时，他们可能都会成功。

不管怎样，一旦这些开始了，我们只需要等待他们 结束：

$all_done->recv;

say "...done";

exit 0;

这就是程序。

我们没有做 Parallel::ForkManager 所做的一件事是 “速率限制”我们的分叉，以便仅n孩子们正在跑步 时间。不过，这很容易手动实现：

 use Coro;
 use AnyEvent::Subprocess; # better abstraction than manually
                           # forking and making watchers
 use Coro::Semaphore;

 my $job = AnyEvent::Subprocess->new(
    on_completion => sub {}, # replace later
    code          => sub { the child process };
 )

 my $rate_limit = Coro::Semaphore->new(3); # 3 procs at a time

 my @coros = map { async {
     my $guard = $rate_limit->guard;
     $job->clone( on_completion => Coro::rouse_cb )->run($_);
     Coro::rouse_wait;
 }} ({ args => 'for first job' }, { args => 'for second job' }, ... );

 # this waits for all jobs to complete
 my @results = map { $_->join } @coros;

这样做的好处是，你可以在孩子的时候做其他事情 正在运行——只是生成更多线程async在你做之前 阻止加入。您对孩子也有更多的控制权 使用 AnyEvent::Subprocess - 您可以在 Pty 中运行子进程并提供 它是标准输入（与 Expect 一样），您可以捕获它的标准输入和标准输出 和 stderr，或者你可以忽略这些东西，或者其他什么。你可以到 决定，而不是某个试图让事情变得“简单”的模块作者。

无论如何，希望这会有所帮助。