标题: [原创代码] [Perl]GUI显示多线程任务进度 [打印本页]
作者: 523066680 时间: 2023-3-5 20:34 标题: [Perl]GUI显示多线程任务进度
本帖最后由 523066680 于 2023-3-5 20:37 编辑
经常遇到需要多线程处理的需求,但是在终端混合输出的结果非常混乱,即使每条信息加上线程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]) }
复制代码
欢迎光临 批处理之家 (http://bathome.net./) |
Powered by Discuz! 7.2 |