当前位置：首页 → 问答吧 → perl下多进程的进度显示

perl下多进程的进度显示

时间：2010-10-07

来源：互联网

经常遇到这样的需求, 一个父进程开启多个子进程, 每个子进程都需要做一个长时间的处理, 所以希望显示这些子进程的进度. 在网上可以找到单进程的进度显示, 但多进程的进度显示没找着.
所以就自己想着做一个, 希望大家给点意见,要是有更好的方法的话请分享一下.

#!/usr/local/bin/perl5
use warnings;
use strict;
use Fcntl;
use Term::Cap;
use Parallel::ForkManager;
#==============================
# for terminal control
#==============================
my $termios = new POSIX::Termios;
my $terminal = Term::Cap->Tgetent ({ TERM => undef, OSPEED => $termios->getospeed });
$terminal->Trequire(qw(cm sc rc)); #check if terminal support these capabilities
my $c = `clear`;
print $c;
#==============================
# for fifo
#==============================
my $fpath = "myfifo";
unless (-p $fpath) {
if (-e _) {
die "$fpath is something unknow\n";
}
else {
require POSIX;
POSIX::mkfifo($fpath, 0666) or die "can not mknod $fpath: $!";
print "$0: created $fpath as a named pipe\n";
}
}
else {
print "$0: named pipe $fpath exists\n";
}
#==============================
# for parallel processes
#==============================
my @names;
push @names, "p$_" foreach 0..5;
my $childs;
$childs->{$_} = {total=>1, processed=>0, name => $names[$_]} foreach(0.. $#names);
my $remain_child_process = scalar @names;
$SIG{PIPE} = sub {
-- $remain_child_process;
print STDERR "pipe broken\n";
};
#==============================
# main program
#==============================
my $now = time;
my $pm = new Parallel::ForkManager(scalar @names);
foreach my $child ( 0 .. $#names ) {
my $pid = $pm->start($names[$child]) and next;
print "This is $names[$child], Child number $child: $\n";
work($child);
$pm->finish($child); # pass an exit code to finish
}
print "Waiting for Children...\n";
show_progress();
$pm->wait_all_children;
$now = time - $now;
printf("\n\nTotal run time: %02d:%02d:%02d\n\n", int($now / 3600), int(($now % 3600) / 60), int($now % 60));
print "Everybody done!\n";
#==============================
# real work of child process
#==============================
sub work {
my $child = shift;
my $total = int(rand(20)) + 5;
foreach (1..$total) {
select(undef, undef, undef, 0.2);
sysopen (FIFO_W, $fpath, O_WRONLY) or die "can't write $fpath: $!";
print FIFO_W "child:$child,processed:$_,total:$total\n";
close FIFO_W;
}
sysopen (FIFO_W, $fpath, O_WRONLY) or die "can't write $fpath: $!";
print FIFO_W "$child over\n";
close FIFO_W;
}
#==================================================
# receive progress data from child and display them
#==================================================
sub show_progress {
while ($remain_child_process) {
die "Pipe file disappeared" unless -p $fpath;
sysopen (FIFO_R, $fpath, O_RDONLY) or die "can't read $fpath: $!";
while(my $m = <FIFO_R>) {
if ($m =~ m/over/) {
-- $remain_child_process;
}
else {
#print $m;
my ($child, $processed, $total) = $m =~ m/child:(\w+),processed:(\d+),total:(\d+)/;
$childs->{$child}->{processed} = $processed;
$childs->{$child}->{total} = $total;
proc_bar($childs);
}
}
close FIFO_R;
}
$terminal->Tgoto('cm', 0, 5+2*@names, *STDOUT); #move cursor to bottom of screen
}
#=====================================
# indicate the progress of comparation
#=====================================
sub proc_bar{
my $childs = shift;
local $| = 1;
$terminal->Tgoto('sc', undef, undef, *STDOUT); #save cursor
for my $c (sort keys %$childs) {
my $i = $childs->{$c}->{processed};
my $n = $childs->{$c}->{total};
my $name = $childs->{$c}->{name};
print "\r\033[36mchild: $c($name) [\033[33m".("#" x int(($i/$n)*50)).(" " x (50 - int(($i/$n)*50)))."\033[36m]";
printf("%2.1f%%\033[0m\n",$i/$n*100);
}
$terminal->Tgoto('rc', undef, undef, *STDOUT); #restore cursor
local $| = 0;
}

复制代码

作者: hp_truth 发布时间: 2010-10-07

支持一下，慢慢看~

作者: x9x9 发布时间: 2010-10-07

perl下多进程的进度显示

热门阅读

热门下载