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

523066680 发表于 2023-04-22 13:20

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

本帖最后由 523066680 于 2023-04-22 13:24 编辑

环境：Win10, Strawberry Perl

经常遇到需要多线程处理的需求，但是在终端混合输出的结果非常混乱，即使每条信息加上线程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, $edit ],
                GAP    => 5,
                MARGIN => "5x5"
            ),
            IUP::Hbox->new(
                child => [ $edit, $edit ],
                GAP    => 5,
                MARGIN => "5x5"
            ),
      ],
      EXPAND => 1,
      GAP    => 5,
      MARGIN => "5x5"
    );

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

    my $tabs = IUP::Tabs->new( child => [$box1, $box2 ], TABTYPE=>"TOP",
      PADDING => "10x10",
      FONTSIZE => "12",
      T**RIENTATION => "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', $_) }
sub utf8 { encode('utf8', $_) }
sub u2gbk { encode('gbk', decode('utf8', $_)) }
sub uni { decode('utf8', $_) }

523066680 发表于 2023-04-22 13:21

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

本帖最后由 523066680 于 2023-04-22 13:27 编辑

发重了，清除内容
论坛使用上是有些问题了，时代也变了，少人用论坛

b114213903 发表于 2023-05-31 14:37

用Win32::GUI，再用不同的线程更新不同的标签（Label）不是更好看？

523066680 发表于 2023-06-06 22:02

本帖最后由 523066680 于 2023-06-06 22:03 编辑

回复 3# b114213903

你是对的 :D

查看完整版本: [Perl]GUI显示多线程任务进度