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

523066680

环境：Win10, Strawberry Perl

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

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

复制代码

523066680

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

b114213903

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

523066680

回复 3# b114213903

你是对的