[Perl]闭包与回调函数 - 多线程下载并显示支线进度

There's more than one way to do it!
https://metacpan.org http://perlmonks.org
头像
523066680
Administrator
Administrator
帖子: 464
注册时间: 2016年07月19日 12:14
拥有现金: 锁定
储蓄: 锁定
Has thanked: 51 times
Been thanked: 91 times
联系:

[Perl]闭包与回调函数 - 多线程下载并显示支线进度

帖子 #1 523066680 » 2019年03月19日 08:38

我们知道有些函数允许通过传递 “函数引用(指针)” 的形式,注册 “回调函数”。
某些事件循环(如timer, idle)、递归模型通过这种方式将数据传出,并转移部分控制权(由你决定怎么处理数据),回调函数执行完后交还控制权。

举个例子,Lwp::UserAgent 下载网络文件,如果要显示下载的详细进度,就可以回调函数实现:
Code: [全选] [展开/折叠] [Download] (Untitled.bsh)
  1. use LWP::UserAgent;
  2. my $url = "http://mirrors.163.com/cpan/authors/id/S/SR/SREZIC/Tk-804.034.tar.gz";
  3. # 全局变量/buffer
  4. our $buffer = "";
  5. my $ua = LWP::UserAgent->new( timeout => 5 );
  6. my $res = $ua->get($url, ':content_cb' => \&detail );
  7.  
  8. sub detail {
  9.     our $buffer;
  10.     my ( $data, $res ) = @_;
  11.     my $total = $res->content_length();
  12.     $buffer .= $data;
  13.     my $recv = length($buffer);
  14.     printf "Progress %.2f%% \n", $recv/$total*100.0;
  15. }

其中 $buffer 是全局变量,用来积累每一步回调时取得的数据。

回调函数有个限制,就是该函数的传参是固定的,函数虽然是你写的,却不能传入、传出其他的东西。
一个临时的办法是设置全局变量($buffer),流通参数以外的数据。

现在增加一下需求,多线程下载不同文件,并且定时显示每个线程的编号以及进度。
单个文件的 $buffer 可以使用全局变量,但若多个文件同时下载怎么区分?通过不同线程调用的回调函数,如何知道自己属于哪一个线程?
通过闭包函数可以实现。
一个极简的示例:
Code: [全选] [展开/折叠] [Download] (Untitled.bsh)
  1. my $ret = closure(1, 2);
  2. print $ret->();
  3. sub closure {
  4.     my ($foo, $bar) = @_;
  5.     return sub { $foo+$bar }
  6. }

closure 函数接受参数$foo和$bar,并返回一个匿名函数引用,同时 $foo $bar 的值确实传递到了子函数内部。
print $ret->() 输出结果为 3
闭包也可以实现类似C语言中 static 做的事情 —— 匿名函数作用域以外、闭包作用域以内的变量值得到保留,用于积累数据。

具体实现:
Code: [全选] [展开/折叠] [Download] (Untitled.bsh)
  1. =info
  2.     523066680/vicyang
  3.     2018-01
  4. =cut
  5.  
  6. use Modern::Perl;
  7. use File::Slurp;
  8. use File::Basename;
  9. use threads;
  10. use threads::shared;
  11. use LWP::UserAgent;
  12. use Time::HiRes qw/sleep/;
  13. use Term::ReadKey;
  14. STDOUT->autoflush(1);
  15.  
  16. our @ths;
  17. our @files :shared;
  18. our @progress :shared;
  19. @progress = (0, 0);
  20.  
  21. @files = (
  22.     "http://mirrors.163.com/cpan/authors/id/S/SR/SREZIC/Tk-804.034.tar.gz",
  23.     "http://mirrors.163.com/cpan/authors/id/J/JC/JCRISTY/PerlMagick-6.89-1.tar.gz"
  24.     );
  25.  
  26. #创建线程
  27. grep { push @ths, threads->create( \&thread, $_ ) } ( 0 .. 1 );
  28.  
  29. #等待运行结束
  30. while ( threads->list(threads::running) ) {
  31.     printf "[1] %5.2f    [2] %5.2f\n", @progress if ( $progress[0]+$progress[1] > 0.0 );
  32.     sleep 0.2;
  33. }
  34. printf "[1] %5.2f    [2] %5.2f\n", @progress;
  35.  
  36. #线程分离/结束
  37. grep { $_->detach() } threads->list(threads::all);
  38. print "Press Any Key to Continue ... ";
  39. ReadKey -1;
  40.  
  41. sub thread
  42. {
  43.     our @mission;
  44.     my $idx = shift;
  45.     my $url = $files[$idx];
  46.     my $ua = LWP::UserAgent->new( timeout => 5, keep_alive=>1 );
  47.  
  48.     printf "[%d] %s\n", $idx+1, basename($url) ;
  49.     my $res = $ua->get($url, ':content_cb' => closure( $idx, basename($url) ) );
  50. }
  51.  
  52. sub closure
  53. {
  54.     our (@progress);
  55.     my ($id, $file) = @_ ;
  56.     my ($total, $part, $recv);
  57.     my $buffer = "";
  58.     $recv = 0;
  59.  
  60.     return sub
  61.     {
  62.         my ($data, $res ) = @_;
  63.         $total = $res->content_length();
  64.         $part = length($data);
  65.         $buffer .= $data;
  66.         $recv += $part;
  67.        
  68.         $progress[$id] = $recv/$total*100.0;
  69.         if ( $recv == $total ) {
  70.             write_file( $file, {binmode=>":raw", err_mode => 'carp' }, $buffer ) or die;
  71.         }
  72.     }
  73. }

$id 是线程编号, $file 是对应文件名,$buffer是积累缓冲区。
运行时每隔0.2秒显示一次线程1、2的下载进度。因为要同时显示进度,而不是交替输出,所以将各自的进度保存到全局变量 @progress,通过线程ID辨别。
Code: [全选] [展开/折叠] [Download] (Untitled.bsh)
  1. [1] Tk-804.034.tar.gz
  2. [2] PerlMagick-6.89-1.tar.gz
  3. [1]  1.62    [2]  2.48
  4. [1] 11.01    [2] 16.07
  5. [1] 20.66    [2] 27.61
  6. [1] 28.89    [2] 39.65
  7. [1] 38.85    [2] 51.89
  8. [1] 48.56    [2] 64.08
  9. [1] 55.43    [2] 72.42
  10. [1] 64.09    [2] 84.12
  11. [1] 71.90    [2] 94.62
  12. [1] 79.64    [2] 100.00
  13. [1] 89.31    [2] 100.00
  14. [1] 100.00    [2] 100.00
  15. Press Any Key to Continue ... [Finished in 2.9s]


最后由 523066680 于 2019年03月19日 08:38 顶起

回到 “Perl”

在线用户

用户浏览此论坛: Bing [Bot] 和 1 访客