multithreading - Perl 模块 ForkManager 不工作

Question

我的错误如下

当您在/usr/lib/perl5/site_perl/5.8.6/Parallel/ForkManager.pm 第 463 行的子进程中时，无法启动另一个进程。

我的代码有问题的部分如下，我的代码下面是在 forkmanager 中失败的子例程，我不知道为什么。没有 forkmanager 我可以运行得很好。

my $pm = new Parallel::ForkManager($MAX_PROCESSES);
for (0..$SCOUNT)
{
my $pid = $pm->start and next;
    my %shash = ();
    %shash =
    (   ID      => "$SREF->[$_]->[0]",
        typeID  => "$SREF->[$_]->[1]",
        extIP   => "$SREF->[$_]->[2]",
        intIP   => "$SREF->[$_]->[3]",
        NAME    => "$SREF->[$_]->[4]",
        buTYPE  => "NULL"
    );
    if ($shash{typeID} =~ /^(4|16|17|25|27|28|42|49|50|51|54|58|60|63|19)$/){$shash{buTYPE} = 'LINUX DEDICATED';}
    if ($shash{typeID} =~ /^(11|14|22|32|34|36|37|46)$/)                    {$shash{buTYPE} = 'LINUX FULL';}
    if ($shash{typeID} =~ /^(44)$/)                                         {$shash{buTYPE} = 'EMAIL MARKETER';}
    if ($shash{typeID} =~ /^(43)$/)                                         {$shash{buTYPE} = 'TYip1';}
    if ($shash{typeID} =~ /^(45)$/)                                         {$shash{buTYPE} = 'DDDOMAINS';}
    if ($shash{typeID} =~ /^(56)$/)                                         {$shash{buTYPE} = 'AT MAIL';}
    if ($shash{typeID} =~ /^(65|66)$/)                                      {$shash{buTYPE} = 'ENT MAIL';}
    if ($shash{typeID} =~ /^(1|3)$/)                                        {$shash{buTYPE} = 'LINUX PROD';}

    if ($shash{buTYPE} eq 'LINUX DEDICATED' || $shash{buTYPE} eq 'LINUX FULL')
    #if ($shash{buTYPE} eq 'LINUX FULL')
    {
        next if (`grep $shash{NAME} $excludes`);
        my $ip;
        my $ipchoice=0;
        print "Doing $shash{NAME}.\n";
        my $testport = testport("$shash{intIP}",'1500');
        if(!$testport)
        {
            $ipchoice=1;
            $testport = testport("$shash{extIP}",'1500');
        }
        unless ($testport)
        {
            log_event("$log/rsync_error.$date_string","Port 1500 closed for $shash{NAME}\n");
            next;
        }
        if ($ipchoice==0)
        {   $ip = $shash{intIP};
        }else{
            $ip = $shash{extIP};
        }
#       send_file("$repo/rsyncd.conf","$shash{intIP}","/etc/rsyncd.conf");
        check_rsync($shash{NAME},$ip);
#       do_backup($shash{NAME},$ip,$shash{buTYPE});
    }
    $pm->finish;
}
$pm->wait_all_children;

ForkManager.pm 编码。

sub start { my ($s,$identification)=@_;
  die "Cannot start another process while you are in the child process"
    if $s->{in_child};
  while ($s->{max_proc} && ( keys %{ $s->{processes} } ) >= $s->{max_proc}) {
    $s->on_wait;
    $s->wait_one_child(defined $s->{on_wait_period} ? &WNOHANG : undef);
  };
  $s->wait_children;
  if ($s->{max_proc}) {
    my $pid=fork();
    die "Cannot fork: $!" if !defined $pid;
    if ($pid) {
      $s->{processes}->{$pid}=$identification;
      $s->on_start($pid,$identification);
    } else {
      $s->{in_child}=1 if !$pid;
    }
    return $pid;
  } else {
    $s->{processes}->{$$}=$identification;
    $s->on_start($$,$identification);
    return 0; # Simulating the child which returns 0
  }
}

Answer 1

您调用next在子进程代码中。尝试执行 for(0..$COUNT) 的下一次迭代，然后尝试 fork再次，这不是你想要的。

你可能想改变

    next if (`grep $shash{NAME} $excludes`);

到

    $pm->finish if (`grep $shash{NAME} $excludes`);