Question

我有一个包含其他目录的目录（目录数是任意的），如下所示：

Main_directory_samples /

subdirectory_sample_1 /
subdirectory_sample_2 /
subdirectory_sample_3 /
subdirectory_sample_4 /

我有一个脚本，该脚本每次接收一个目录作为输入，并且运行1h（对于每个目录）。要运行脚本，我需要以下代码：

opendir DIR, $maindirectory or die "Can't open directory!!";
while(my $dir = readdir DIR){
    if($dir ne '.' && $dir ne '..'){ 
        system("/bin/bash", "my_script.sh", $maindirectory.'/'.$dir);    
    }   
}
closedir DIR;

但是，我想同时为不同目录运行脚本。例如，“ subdirectory_sample_1 /”和“ subdirectory_sample_2 /”将在同一线程中运行； 'subdirectory_sample_3 /'和'subdirectory_sample_4 /'在另一个中。但是我只是找不到办法。

Answer 1

在您刚刚启动外部进程并等待它们时，一个非线程选项：

use strict;
use warnings;
use Path::Tiny;
use IO::Async::Loop;
use Future::Utils 'fmap_concat';

my $loop = IO::Async::Loop->new;

my $maindirectory = '/foo/bar';
my @subdirs = grep { -d } path($maindirectory)->children; # excludes . and ..

# runs this code to maintain up to 'concurrent' pending futures at once
my $main_future = fmap_concat {
  my $dir = shift;
  my $future = $loop->new_future;
  my $process = $loop->open_process(
    command => ['/bin/bash', 'my_script.sh', $dir],
    on_finish => sub { $future->done(@_) },
    on_exception => sub { $future->fail(@_) },
  );
  return $future;
} foreach => \@subdirs, concurrent => 2;

# run event loop until all futures are done or one fails, throw exception on failure
my @exit_codes = $main_future->get;

请参阅IO::Async::Loop和Future::Utils的文档。

Answer 2

一种方法是fork，并在每个子进程中处理一组目录。

一个基本示例

use warnings;
use strict;
use feature 'say';

use List::MoreUtils qw(natatime);
use POSIX qw(:sys_wait_h);  # for WNOHANG
use Time::HiRes qw(sleep);  # for fractional seconds

my @all_dirs = qw(d1 d2 d3 d4);
my $path = 'maindir';
my @procs;

# Get iterator over groups (of 2)
my $it = natatime 2, @all_dirs;

while (my @dirs = $it->()) { 

    my $pid = fork // do {      #/
        warn "Can't fork for @dirs: $!";
        next;
    };

    if ($pid == 0) { 
        foreach my $dir (@dirs) {
            my @cmd = ('/bin/bash/', 'my_script.sh', "$path/$dir");
            say "in $$, \@cmd: (@cmd)"; 
            # system(@cmd) == 0 or do { inspect $? }
        };  
        exit;
    };  
    push @procs, $pid;
}

# Poll with non-blocking wait for processes (reap them)
my $gone;
while (($gone = waitpid -1, WNOHANG) > -1) {
    my $status = $?; 
    say "Process $gone exited with $status" if $gone > 0;
    sleep 0.1;
}

有关详细信息，请参见system和/或exec，尤其是关于错误检查以及$? variable。可以将其解压缩以获取有关该错误的更多详细信息。或者，至少打印警告并跳到下一项（无论如何会发生在上面）。

上面的代码打印出命令和pid的退出状态，但将@cmd替换为无影响的测试命令，并取消注释system行以进行尝试。

注意有多少工作。一个基本的经验法则是，每个内核开始时性能不超过2个，但这取决于许多细节。尝试找到适合您情况的最佳选择。我喜欢每个核心有一份工作，然后至少一个核心免费。为了抑制这种情况，请参见最后链接的模块。

为了将所有作业（目录）分成几组，我使用了List::MoreUtils中的natatime（每次n次）。如果有关于如何对目录进行分组的更具体的标准，请进行调整。

请参阅Forks::Super和Parallel::ForkManager，以了解用于处理分叉进程的更高级方法。

Perl同时为不同的目录运行相同的脚本

2 个答案: