[原创代码] [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]) }
复制代码