Perl 如何分叉和读取多个子进程？

我的主要目标是为一个大的对象列表做一些工作（外部取决于时间开销）。因此，如果我直截了当地做这件事，那就需要很多时间。所以我决定进入并行模式，并分叉一些（4-8，让我们看看）子进程，每个子进程都为一组较小的对象执行任务。在主（父）流程中，我希望打印出与单流程版本相同的总体进度统计信息

然而，当我分叉4个子进程并在其中执行一些工作时，我可以看到它们是活动的，但实际上只有一个正在执行某些操作并将信息发送回父进程

这是我到目前为止所做的代码——耗时的部分用随机usleep模拟，它很好地模拟了它的行为

#!/usr/bin/env perl
use strict;
use warnings;

use DateTime;
use DateTime::Format::HTTP;
use Time::HiRes;

my @to_be_processed = (1..300000);
my @queues;
my $nprocs = 4;

my $parent_from_child;
my @child_from_parent;
my @child_to_parent;

$SIG{CHLD} = 'IGNORE';
$|=1; # autoflush

my %stat = (
    total           => scalar(@to_be_processed),
    processed       => 0,
    time_started    => [Time::HiRes::gettimeofday],
);

# divide the list into queues for each subprocess
for (my $i = 0; $i < $stat{total}; $i++ ) {
    my $queue = $i % $nprocs;
    push @{$queues[$queue]}, $to_be_processed[$i];
}

# for progress simulation
srand (time ^ $$);

for (my $proc = 0; $proc < $nprocs; $proc++) {

    # set up the pipes
    pipe $parent_from_child, $child_to_parent[$proc]        or die "pipe failed - $!";

    # fork
    defined(my $pid = fork) or die "fork failed - $!";

    if ($pid) {
        # parent
        close $child_to_parent[$proc];
        printf("[%u] parent says: child %u created with pid %u\n", $$, $proc, $pid);
    }
    else {
        # child
        close $parent_from_child;
        open(STDOUT, ">&=" . fileno($child_to_parent[$proc]))   or die "open failed - $!";

        warn(sprintf("[%u] child alive with %u entries\n", $$, scalar(@{$queues[$proc]})));

        foreach my $id (@{$queues[$proc]}) {
            printf("START: %s\n", $id);

            # simulation of progress
            my $random_microseconds = int(rand(3000000))+200000;
            warn(sprintf("[%u] child 'works' for %u microseconds", $$, $random_microseconds));
            Time::HiRes::usleep( $random_microseconds );

            printf("DONE\n")
        }
        exit(0);
    }
}

# parent: receive data from children and print overall statistics
while (<$parent_from_child>) {
    chomp(my $line = $_);

    if ($line =~ m/^START: (\S+)/) {
        my ($id) = @_;

        printf("%6u/%6u", $stat{processed}, $stat{total});
        if ($stat{time_avg}) {
            my $remaining = ($stat{total} - $stat{processed}) * $stat{time_avg};
            my $eta = DateTime->from_epoch( epoch => time + $remaining );
            $eta->set_time_zone('Europe/Berlin');
            printf(" (ETA %s)", DateTime::Format::HTTP->format_isoz($eta));
        }
        printf("\r");
    }
    elsif ($line =~ /^DONE/) {
        $stat{processed}++;
        $stat{time_processed} = Time::HiRes::tv_interval( $stat{time_started} );
        $stat{time_avg}       = $stat{time_processed} / $stat{processed};
    }
    else {
        printf("%s\n", $line);
    }
}

#/usr/bin/env perl
严格使用；
使用警告；
使用日期时间；
使用DateTime:：Format:：HTTP；
使用时间：：雇佣；
我的@to_be__processed=（1..300000）；
我的@队列；
我的$nprocs=4；
我的$parent\u来自\u child；
我的父母给我的孩子；
我的@child\u对我的父母；
$SIG{CHLD}='IGNORE'；
$|=1; # 自动冲洗
我的%stat=(
总计=>标量（@待处理），
已处理=>0，
开始时间=>[time:：HiRes:：gettimeofday]，
);
#将列表划分为每个子流程的队列
对于（my$i=0；$i<$stat{total}；$i++）{
我的$queue=$i%$NPROC；
推送{$queues[$queue]}，$待处理[$i]；
}
#进度模拟
srand（时间^$$）；
对于（我的$proc=0；$proc<$nprocs；$proc++）{
#安装管道
将$parent\u从\u child、$child\u传输到\u parent[$proc]或死“管道失败-$！”；
#叉子
定义（my$pid=fork）或死“fork failed-$！”；
如果（$pid）{
#母公司
关闭$child_to_parent[$proc]；
printf（“[%u]父项表示：使用pid%u\n创建的子项%u”，$$，$proc，$pid）；
}
否则{
#孩子
从子项关闭$parent\u；
打开（标准输出“>”&=“.fileno（$child_to_parent[$proc]））或死亡“打开失败-$！”；
警告（sprintf（“[%u]子活动，有%u个条目\n”，$$，标量（@{$queues[$proc]}））；
foreach my$id（@{$queues[$proc]}）{
printf（“开始：%s\n”，$id）；
#进程模拟
我的$random_微秒=int（兰特（3000000））+200000；
警告（sprintf（“[%u]子项“工作”达%u微秒“，$$，$random_微秒））；
时间：：雇佣：：usleep（$random_微秒）；
printf（“完成\n”）
}
出口（0）；
}
}
#父项：从子项接收数据并打印总体统计信息
而（）{
chomp（我的$line=$）；
如果（$line=~m/^START:（\S+/）{
我的（$id）=@；
printf（“%6u/%6u”，$stat{processed}，$stat{total}）；
如果（$stat{time_avg}）{
my$剩余=（$stat{total}-$stat{processed}）*$stat{time_avg}；
my$eta=DateTime->from_epoch（epoch=>time+$resisting）；
$eta->设置时区（“欧洲/柏林”）；
printf（“（ETA%s）”，DateTime:：Format:：HTTP->Format_isoz（$ETA））；
}
printf（“\r”）；
}
elsif（$line=~/^DONE/）{
$stat{processed}++；
$stat{time\u processed}=time:：HiRes:：tv\u interval（$stat{time\u start}）；
$stat{time\u avg}=$stat{time\u processed}/$stat{processed}；
}
否则{
printf（“%s\n”，$line）；
}
}

通常应消除警告。 如果你运行它，你应该看到只有一个孩子可以工作。 我的问题是：为什么？我的错误在哪里？我怎样才能让他们都做好工作

谢谢

---

K.

您可以在strace下运行perl，您会发现您孩子的生命相当短暂，如下所示：

close(3)                                = 0
ioctl(4, SNDCTL_TMR_TIMEBASE or TCGETS, 0x7fff753b3a10) = -1 EINVAL (Invalid argument)
lseek(4, 0, SEEK_CUR)                   = -1 ESPIPE (Illegal seek)
fstat(4, {st_mode=S_IFIFO|0600, st_size=0, ...}) = 0
dup2(4, 1)                              = 1
dup(4)                                  = 3
fcntl(4, F_GETFD)                       = 0x1 (flags FD_CLOEXEC)
dup2(3, 4)                              = 4
fcntl(4, F_SETFD, FD_CLOEXEC)           = 0
close(3)                                = 0
fcntl(1, F_SETFD, 0)                    = 0
write(2, "[30629] child alive with 75000 e"..., 39) = 39
brk(0x3582000)                          = 0x3582000
write(1, "START: 1\n", 9)               = -1 EPIPE (Broken pipe)
--- SIGPIPE (Broken pipe) @ 0 (0) ---

这就是为什么：

pipe $parent_from_child, $child_to_parent[$proc]        or die "pipe failed - $!";

您在管道的错误参数上使用了数组。您需要在父级中保持所有读取面打开。相反，您已经设置了一个数组，以便父级可以保持所有写端打开（但在父级块中，您会立即关闭写端）。因此，下次通过循环时，

pipe

创建一个新句柄，将其分配给

$parent\u from\u child

。因此，旧值没有更多的引用，perl将其清除，这意味着它将关闭文件句柄。所以你的孩子除了最后一个都死了

我认为您的印象是，您可以重用该读句柄，只需为其分配多个写句柄。你不能<代码>管道始终生成新的读取句柄和写入句柄

如果您真的想要共享相同的读取句柄（您可能不想，当两个客户端的输出交错时，这将导致损坏），只需在循环之外创建一次即可。所有子级都将通过

fork

继承相同的写句柄。更可能的情况是，您希望每个孩子有一个，您必须使用

select

循环来查看哪些孩子有可用的输出，并读取这些输出

---

或者，我确信CPAN为您准备了一个现成的解决方案（或十个）。

太好了！非常感谢！是的，我想我可以在同一个手柄上阅读，它可以与冲洗等一起使用。现在，我使用IO:：Select和一个can_read（）循环完成了这项工作，这就像一个符咒。当然，在父级中初始化它会导致每个子级的顺序相同。