• 【中国梦·大国工匠篇】鸡蛋上钻孔显真功 潜心坚守一线练就绝活儿 2019-06-11
  • 【理上网来·喜迎十九大】塞尔维亚驻华大使:中国的发展是其他国家望尘莫及的 2019-06-10
  • 六大工程培育发展新动能 2019-06-10
  • 为推动上合组织发展提供中国智慧、中国方案 2019-05-29
  • 覆盖31亿人口!一图告诉你上合组织有多牛 2019-05-28
  • 德味手表了解一下 徕卡推出L1,L2机械表德味手表徕卡推出L1-手机行情 2019-05-28
  • 西部网(陕西新闻网)www.cnwest.com 2019-05-27
  • 穿越千年 感悟周公 2019-05-27
  • 2017年度一级建造师考试成绩已发布 2019-05-27
  • 【大考2018】2018高考首日众生相(组图) 2019-05-27
  • 浙江舟山定海区一国企非党管理人员涉嫌受贿被查 2019-05-23
  • 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28
  • 批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
    [批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
    返回列表 发帖

    广东十一选五现场开奖:[原创教程] [Perl]闭包与回调函数 - 多线程下载并显示各自进度

    本帖最后由 523066680 于 2019-3-7 20:32 编辑

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

    举个例子,Lwp::UserAgent 下载网络文件,如果要显示下载的详细进度,就可以回调函数实现:
     广东十一选五计划软件 www.qe-ar.com 
    1. use LWP::UserAgent;
    2. my $url = "//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. sub detail {
    8.     our $buffer;
    9.     my ( $data, $res ) = @_;
    10.     my $total = $res->content_length();
    11.     $buffer .= $data;
    12.     my $recv = length($buffer);
    13.     printf "Progress %.2f%% \n", $recv/$total*100.0;
    14. }
    复制代码
    其中 $buffer 是全局变量,用来积累每一步回调时取得的数据。

    回调函数有个限制:传参是固定的、也不能返回值?;欢灾?,函数体是你写的,规矩却不是你定的。
    临时的办法是用全局变量($buffer)流通参数以外的数据。

    现在增加一下需求,多线程下载不同文件,并且持续显示每个线程对应的下载进度。
    单个文件的 $buffer 可以使用全局变量,但若多个文件同时下载怎么区分?受不同线程调用的回调函数,如何知道自己属于哪一个线程?
    通过闭包函数可以实现。
    一个极简的示例:
    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 做的事情 —— 匿名函数作用域以外、闭包作用域以内的变量值得到保留,用于积累数据。

    具体实现:
    1. =info
    2.     523066680/vicyang
    3.     2018-01
    4. =cut
    5. use Modern::Perl;
    6. use File::Slurp;
    7. use File::Basename;
    8. use threads;
    9. use threads::shared;
    10. use LWP::UserAgent;
    11. use Time::HiRes qw/sleep/;
    12. use Term::ReadKey;
    13. STDOUT->autoflush(1);
    14. our @ths;
    15. our @files :shared;
    16. our @progress :shared;
    17. @progress = (0, 0);
    18. @files = (
    19.     "//mirrors.163.com/cpan/authors/id/S/SR/SREZIC/Tk-804.034.tar.gz",
    20.     "//mirrors.163.com/cpan/authors/id/J/JC/JCRISTY/PerlMagick-6.89-1.tar.gz"
    21.     );
    22. #创建线程
    23. grep { push @ths, threads->create( \&thread, $_ ) } ( 0 .. 1 );
    24. #等待运行结束
    25. while ( threads->list(threads::running) ) {
    26.     printf "[1] %5.2f    [2] %5.2f\n", @progress if ( $progress[0]+$progress[1] > 0.0 );
    27.     sleep 0.2;
    28. }
    29. printf "[1] %5.2f    [2] %5.2f\n", @progress;
    30. #线程分离/结束
    31. grep { $_->detach() } threads->list(threads::all);
    32. print "Press Any Key to Continue ... ";
    33. ReadKey -1;
    34. sub thread
    35. {
    36.     our @mission;
    37.     my $idx = shift;
    38.     my $url = $files[$idx];
    39.     my $ua = LWP::UserAgent->new( timeout => 5, keep_alive=>1 );
    40.     printf "[%d] %s\n", $idx+1, basename($url) ;
    41.     my $res = $ua->get($url, ':content_cb' => closure( $idx, basename($url) ) );
    42. }
    43. sub closure
    44. {
    45.     our (@progress);
    46.     my ($id, $file) = @_ ;
    47.     my ($total, $part, $recv);
    48.     my $buffer = "";
    49.     $recv = 0;
    50.     return sub
    51.     {
    52.         my ($data, $res ) = @_;
    53.         $total = $res->content_length();
    54.         $part = length($data);
    55.         $buffer .= $data;
    56.         $recv += $part;
    57.         
    58.         $progress[$id] = $recv/$total*100.0;
    59.         if ( $recv == $total ) {
    60.             write_file( $file, {binmode=>":raw", err_mode => 'carp' }, $buffer ) or die;
    61.         }
    62.     }
    63. }
    复制代码
    $id 是线程编号, $file 是对应文件名,$buffer是积累缓冲区。
    运行时每隔0.2秒显示一次线程1、2的下载进度。因为要同时显示进度,而不是交替输出,所以将各自的进度保存到全局变量 @progress,通过线程ID辨别。
    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]
    复制代码
    1

    评分人数

      • ivor: 感谢分享技术 + 1
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    返回列表
  • 【中国梦·大国工匠篇】鸡蛋上钻孔显真功 潜心坚守一线练就绝活儿 2019-06-11
  • 【理上网来·喜迎十九大】塞尔维亚驻华大使:中国的发展是其他国家望尘莫及的 2019-06-10
  • 六大工程培育发展新动能 2019-06-10
  • 为推动上合组织发展提供中国智慧、中国方案 2019-05-29
  • 覆盖31亿人口!一图告诉你上合组织有多牛 2019-05-28
  • 德味手表了解一下 徕卡推出L1,L2机械表德味手表徕卡推出L1-手机行情 2019-05-28
  • 西部网(陕西新闻网)www.cnwest.com 2019-05-27
  • 穿越千年 感悟周公 2019-05-27
  • 2017年度一级建造师考试成绩已发布 2019-05-27
  • 【大考2018】2018高考首日众生相(组图) 2019-05-27
  • 浙江舟山定海区一国企非党管理人员涉嫌受贿被查 2019-05-23
  • 让山里娃感受智慧科技乐趣 2019-05-19
  • 香港田径锦标赛飞人夺冠 2019-05-19
  • 诽谤侮辱英烈可追刑责 2019-05-14
  • 图解:十二字“洞见”2017年保险业 2019-04-28