[新手上路]批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程[批处理精品]批处理版照片整理器
[批处理精品]纯批处理备份&还原驱动[批处理精品]CMD命令50条不能说的秘密[在线下载]第三方命令行工具[在线帮助]VBScript / JScript 在线参考
返回列表 发帖

[原创代码] [Perl]GUI显示多线程任务进度

本帖最后由 523066680 于 2023-3-5 20:37 编辑

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

  1. # Code By 523066680
  2. use utf8;
  3. use Modern::Perl;
  4. use Encode;
  5. use threads;
  6. use threads::shared;
  7. use Time::HiRes qw/sleep time/;
  8. use IUP ':all';
  9. STDOUT->autoflush(1);
  10. my $th_count = 8;
  11. # 不同线程的日志缓存
  12. my @log :shared;
  13. @log = map { utf8("线程 $_ \n") } ( 0 .. $th_count );  # 0 占位
  14. my @ths;
  15. # 创建线程
  16. grep { push @ths, threads->create( \&th_func, $_ ) } ( 1 .. $th_count );
  17. push @ths, threads->create( \&GUI, 4 );
  18. # 等待运行结束
  19. while ( threads->list(threads::running) ) { sleep 0.2 };
  20. # 线程分离/结束
  21. grep { $_->detach() } threads->list(threads::all);
  22. sub th_func
  23. {
  24.     my ( $id ) = @_;
  25.     $SIG{'KILL'} = sub { threads->exit(); };
  26.     # printf "%d %s\n", $id, $log[$id];
  27.     open my $FH, ">>:utf8", \$log[$id];
  28.     select $FH;
  29.     my $n = 1;
  30.     while ( 1 )
  31.     {
  32.         printf "线程 %d -> %03d\n", $id, $n++;
  33.         sleep 0.2;
  34.     }
  35. }
  36. sub GUI
  37. {
  38.     our @edit;
  39.     for my $n ( 1 .. $th_count )
  40.     {
  41.         push @edit, IUP::Text->new(
  42.             FONT => "Simsun, 10",
  43.             MULTILINE => "YES",
  44.             BORDER    => "YES",
  45.             SCROLLBAR => "VERTICAL",
  46.             EXPAND=>"YES",
  47.             BGCOLOR => "#000000",
  48.             FGCOLOR => "#FFFFFF",
  49.             VALUE => "",
  50.         );
  51.     }
  52.     my $box1 = IUP::Vbox->new(
  53.         TABTITLE => "1~4",
  54.         child => [
  55.             IUP::Hbox->new(
  56.                 child => [ $edit[0], $edit[1] ],
  57.                 GAP    => 5,
  58.                 MARGIN => "5x5"
  59.             ),
  60.             IUP::Hbox->new(
  61.                 child => [ $edit[2], $edit[3] ],
  62.                 GAP    => 5,
  63.                 MARGIN => "5x5"
  64.             ),
  65.         ],
  66.         EXPAND => 1,
  67.         GAP    => 5,
  68.         MARGIN => "5x5"
  69.     );
  70.     my $box2 = IUP::Vbox->new(
  71.         TABTITLE => "5~8",
  72.         child => [
  73.             IUP::Hbox->new(
  74.                 child => [ $edit[4], $edit[5] ],
  75.                 GAP    => 5,
  76.                 MARGIN => "5x5"
  77.             ),
  78.             IUP::Hbox->new(
  79.                 child => [ $edit[6], $edit[7] ],
  80.                 GAP    => 5,
  81.                 MARGIN => "5x5"
  82.             ),
  83.         ],
  84.         EXPAND => 1,
  85.         GAP    => 5,
  86.         MARGIN => "5x5"
  87.     );
  88.     my $tabs = IUP::Tabs->new( child => [$box1, $box2 ], TABTYPE=>"TOP",
  89.         PADDING => "10x10",
  90.         FONTSIZE => "12",
  91.         TABORIENTATION => "HORIZONTAL",
  92.     );
  93.     my $dlg = IUP::Dialog->new(
  94.         child => $tabs,
  95.         TITLE => "Console",
  96.         SIZE  => "450x250",
  97.     );
  98.     IUP::Timer->new(ACTION_CB => msg_update->( \@edit ), TIME => 200, RUN=>'YES');
  99.     $dlg->ShowXY( IUP_CENTER, IUP_CENTER );
  100.     IUP->MainLoop;
  101.     # 如果GUI线程结束
  102.     for (  threads->list(threads::all) )
  103.     {
  104.         if ( $_->tid() != threads->tid() )
  105.         {
  106.             $_->kill("KILL")->detach();
  107.             printf "detach %d\n", $_->tid();
  108.         }
  109.     }
  110. }
  111. # 日志更新显示
  112. sub msg_update
  113. {
  114.     my ( $edit ) = @_;
  115.     # 记录每个ID日志的offset,只打印增量的部分
  116.     # 解决滚动条反弹到顶部的问题 - 如果每次都使用 $obj->VALUE 打印整个日志的话
  117.     my @offset = map {0} ( 0 .. $th_count );
  118.     return sub
  119.     {
  120.         for my $id ( 1 .. $th_count )
  121.         {
  122.             my $len = length( $log[$id] );
  123.             if ( $offset[$id] == 0 )
  124.             {
  125.                 $log[$id] =~ s/\n$//;
  126.                 $edit->[$id-1]->APPEND( $log[$id], 0 );
  127.                 $offset[$id] = $len - 1; # 去掉一个换行符
  128.             }
  129.             elsif ( $len > $offset[$id] )
  130.             {
  131.                 my $str = substr( $log[$id], $offset[$id] );
  132.                 $str=~s/\n$//;
  133.                 $edit->[$id-1]->APPEND( $str );
  134.                 $offset[$id] = $len;
  135.             }
  136.             #$edit->[$id-1]->VALUE( $log[$id] );
  137.         }
  138.         
  139.         return IUP_DEFAULT;
  140.     };
  141. }
  142. sub gbk { encode('gbk', $_[0]) }
  143. sub utf8 { encode('utf8', $_[0]) }
  144. sub u2gbk { encode('gbk', decode('utf8', $_[0])) }
  145. sub uni { decode('utf8', $_[0]) }
复制代码

返回列表