[Perl]GUI显示多线程任务进度

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
回复
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

[Perl]GUI显示多线程任务进度

帖子 523066680 »

经常遇到需要多线程处理的需求,但是在终端混合输出的结果非常混乱,即使每条信息加上线程ID,又或是使用不同的缩进。
最初考虑在线程间共享GUI句柄,结果发现仅有的几个GUI框架并不支持线程共享。
于是改了方案,单独开一个线程跑GUI,创建一个线程共享的字符串数组,存储日志。
通过 open $H, ">", \$str 的方式为字符串变量创建输出流句柄,然后 select $H 取代STDOUT输出。
在GUI的文本显示模块中动态更新字符串内容,目的达成。

图片

代码: 全选

# Code By 523066680
use utf8;
use Modern::Perl;
use Encode;
use threads;
use threads::shared;
use Time::HiRes qw/sleep time/;
use IUP ':all';

STDOUT->autoflush(1);
my $th_count = 8;

# 不同线程的日志缓存
my @log :shared;
@log = map { utf8("线程 $_ \n") } ( 0 .. $th_count );  # 0 占位

my @ths;
# 创建线程
grep { push @ths, threads->create( \&th_func, $_ ) } ( 1 .. $th_count );
push @ths, threads->create( \&GUI, 4 );

# 等待运行结束
while ( threads->list(threads::running) ) { sleep 0.2 };

# 线程分离/结束
grep { $_->detach() } threads->list(threads::all);

sub th_func
{
    my ( $id ) = @_;

$SIG{'KILL'} = sub { threads->exit(); };

# printf "%d %s\n", $id, $log[$id];
open my $FH, ">>:utf8", \$log[$id];
select $FH;

my $n = 1;
while ( 1 )
{
    printf "线程 %d -> %03d\n", $id, $n++;
    sleep 0.2;
}
}

sub GUI
{
    our @edit;
    for my $n ( 1 .. $th_count )
    {
        push @edit, IUP::Text->new( 
            FONT => "Simsun, 10",
            MULTILINE => "YES",
            BORDER    => "YES",
            SCROLLBAR => "VERTICAL",
            EXPAND=>"YES",
            BGCOLOR => "#000000",
            FGCOLOR => "#FFFFFF",
            VALUE => "",
        );
    }

my $box1 = IUP::Vbox->new(
    TABTITLE => "1~4",
    child => [
        IUP::Hbox->new(
            child => [ $edit[0], $edit[1] ],
            GAP    => 5,
            MARGIN => "5x5"
        ),
        IUP::Hbox->new(
            child => [ $edit[2], $edit[3] ],
            GAP    => 5,
            MARGIN => "5x5"
        ),
    ],
    EXPAND => 1,
    GAP    => 5,
    MARGIN => "5x5"
);

my $box2 = IUP::Vbox->new(
    TABTITLE => "5~8",
    child => [
        IUP::Hbox->new(
            child => [ $edit[4], $edit[5] ],
            GAP    => 5,
            MARGIN => "5x5"
        ),
        IUP::Hbox->new(
            child => [ $edit[6], $edit[7] ],
            GAP    => 5,
            MARGIN => "5x5"
        ),
    ],
    EXPAND => 1,
    GAP    => 5,
    MARGIN => "5x5"
);

my $tabs = IUP::Tabs->new( child => [$box1, $box2 ], TABTYPE=>"TOP", 
    PADDING => "10x10",
    FONTSIZE => "12",
    TABORIENTATION => "HORIZONTAL",
);

my $dlg = IUP::Dialog->new(
    child => $tabs,
    TITLE => "Console",
    SIZE  => "450x250",
);

IUP::Timer->new(ACTION_CB => msg_update->( \@edit ), TIME => 200, RUN=>'YES');
$dlg->ShowXY( IUP_CENTER, IUP_CENTER );

IUP->MainLoop;

# 如果GUI线程结束
for (  threads->list(threads::all) )
{
    if ( $_->tid() != threads->tid() )
    {
        $_->kill("KILL")->detach();
        printf "detach %d\n", $_->tid();
    }
}
}

# 日志更新显示
sub msg_update
{
    my ( $edit ) = @_;
    # 记录每个ID日志的offset,只打印增量的部分
    # 解决滚动条反弹到顶部的问题 - 如果每次都使用 $obj->VALUE 打印整个日志的话
    my @offset = map {0} ( 0 .. $th_count );

return sub
{
    for my $id ( 1 .. $th_count )
    {
        my $len = length( $log[$id] );
        if ( $offset[$id] == 0 )
        {
            $log[$id] =~ s/\n$//;
            $edit->[$id-1]->APPEND( $log[$id], 0 );
            $offset[$id] = $len - 1; # 去掉一个换行符
        }
        elsif ( $len > $offset[$id] )
        {
            my $str = substr( $log[$id], $offset[$id] );
            $str=~s/\n$//;
            $edit->[$id-1]->APPEND( $str );
            $offset[$id] = $len;
        }

        #$edit->[$id-1]->VALUE( $log[$id] );
    }
    
    return IUP_DEFAULT;
};
}

sub gbk { encode('gbk', $_[0]) }
sub utf8 { encode('utf8', $_[0]) }
sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
sub uni { decode('utf8', $_[0]) }
头像
523066680
Administrator
Administrator
帖子: 573
注册时间: 2016年07月19日 12:14
联系:

Re: [Perl]GUI显示多线程任务进度

帖子 523066680 »

刚发现, 这个语法高亮竟然会出现代码不完整的情况……

又看了一眼 问题不大,缩进丢失。对python不友好 :shy

回复

在线用户

正浏览此版面之用户: 没有注册用户 和 0 访客