hàng đợi xử lý perl

Question

Tôi có một kịch bản Perl để dồn một số quy trình phụ. Tôi muốn có một số chức năng như xargs --max-procs=4 --max-args=1 hoặc make -j 4, trong đó Perl sẽ giữ một số quy trình nhất định chạy cho đến khi nó hết hiệu lực. Thật dễ dàng để nói đến ngã ba bốn quá trình và chờ đợi cho họ tất cả để hoàn thành, và sau đó ngã ba khác bốn, nhưng tôi muốn giữ bốn hoặc n quy trình chạy cùng một lúc, thúc đẩy một quá trình mới ngay sau khi một hoàn thành.

Có cách nào đơn giản trong Perl để triển khai một nhóm xử lý như vậy không?

Answer 1

Forks::Super có thể xử lý yêu cầu này.

Các cuộc gọi đến fork() có thể chặn cho đến khi số lượng subprocesses hoạt động giảm xuống dưới 5, hoặc bạn có thể vượt qua các thông số bổ sung cho fork cuộc gọi và các nhiệm vụ để thực hiện có thể xếp hàng lên:

fork { sub => sub { ... task to run in subprocess ... } } 

Khi một subprocess kết thúc, một công việc khác trên hàng đợi sẽ khởi động.

(Tôi là tác giả của mô-đun này).

Answer 2

Kiểm tra Parallel::ForkManager - nó thực hiện nhiều điều bạn mô tả. Bạn có thể đặt số lượng quy trình tối đa và chức năng gọi lại có thể bắt đầu một con mới ngay sau khi hoàn tất (miễn là có việc phải làm).

Answer 3

Trong khi tôi hầu như luôn sử dụng mô-đun CPAN, hoặc viết gì đó với các mô-đun AnyEvent tuyệt vời, tôi nghĩ điều quan trọng là phải hiểu những thứ này hoạt động như thế nào dưới mui xe. Đây là một ví dụ không có phụ thuộc khác ngoài perl. Cách tiếp cận tương tự cũng có thể được viết bằng C mà không gặp quá nhiều rắc rối.

#!/usr/bin/env perl 

use strict; 

## run a function in a forked process 
sub background (&) { 
    my $code = shift; 

    my $pid = fork; 
    if ($pid) { 
    return $pid; 
    } elsif ($pid == 0) { 
    $code->(); 
    exit; 
    } else{ 
    die "cant fork: $!" 
    } 
} 

my @work = ('sleep 30') x 8; 
my %pids =(); 
for (1..4) { 
    my $w = shift @work; 
    my $pid = background { 
    exec $w; 
    }; 
    $pids{$pid} = $w; 
} 

while (my $pid = waitpid(-1,0)) { 
    if ($?) { 
    if ($? & 127) { 
     warn "child died with signal " . ($? & 127); 
    } else { 
     warn "chiled exited with value " . ($? >> 8); 
    } 

    ## redo work that died or got killed 
    my $npid = background { 
     exec $pids{$pid}; 
    }; 
    $pids{$npid} = delete $pids{$pid}; 
    } else { 
    delete $pids{$pid}; 

    ## send more work if there is any 
    if (my $w = shift @work) { 
     my $pid = background { 
     exec shift @work; 
     }; 
     $pids{$pid} = $w; 
    } 
    } 
}