免费注册 查看新帖 |

ChinaUnix.net

  平台 论坛 博客 文库 频道自动化运维 虚拟化 储存备份 C/C++ PHP MySQL 嵌入式 Linux系统
最近访问板块 发新帖
查看: 1234 | 回复: 1

[Perl]批量下载美女壁纸(ZOL桌面壁纸) [复制链接]

论坛徽章:
11
子鼠
日期:2014-10-11 16:46:4815-16赛季CBA联赛之山东
日期:2017-11-10 14:32:142016科比退役纪念章
日期:2017-09-02 15:42:4715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:5515-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亚冠之萨济拖拉机
日期:2015-05-22 11:38:532016科比退役纪念章
日期:2018-03-16 10:24:05
发表于 2018-11-01 11:39 |显示全部楼层
最近需要素材便写了,没有加入多线程,就这样按顺序抓~
如果因为某种原因中断了,重新开始,会判断已完成的部分节省时间。

keep_alive 打开后好像会导致后续页面访问不了,所以没开。

运行环境: Straberry Perl 5.24
  1. =info
  2.     Author: 523066680/vicyang
  3.     Date: 2018-11
  4. =cut

  5. use Encode;
  6. use LWP::UserAgent;
  7. use Mojo::DOM;
  8. use File::Slurp;
  9. use File::Basename qw/basename/;
  10. use File::Path qw/mkpath/;
  11. STDOUT->autoflush(1);

  12. our $wdir = "D:/temp/wallpaper_zol/meinv";
  13. our $main = "http://desk.zol.com.cn";
  14. my $ua = LWP::UserAgent->new( agent => "Mozilla/5.0" );
  15. our @headers = (
  16.         "Host" => "desk.zol.com.cn",
  17.         "User-Agent" => "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:63.0) Gecko/20100101 Firefox/63.0",
  18.     );

  19. mkpath $wdir unless -e $wdir;
  20. chdir $wdir;

  21. # 获取所有主题链接
  22. my @items;
  23. my $iter = 1;
  24. while ( get_item( $main ."/meinv/${iter}.html", \@items ) >= 1 )
  25. {
  26.     $iter++;
  27. }

  28. # 遍历页面、提取图片
  29. my $idx = 0;
  30. for my $item ( @items )
  31. {
  32.     printf "[%03d/%d] %s %s\n",  $idx++ , $#items+1, $item->{link}, $item->{title};
  33.     get_pages( $item->{link}, $item->{title} );
  34. }

  35. sub get_item
  36. {
  37.     our ($main, @headers);
  38.     my ( $link, $ref ) = @_;
  39.     # 重建 UserAgent 对象
  40.     my $ua = LWP::UserAgent->new();
  41.     my $res = $ua->get($link, @headers);
  42.     my $dom = Mojo::DOM->new( $res->content );

  43.     for my $e ( $dom->find(".photo-list-padding")->each )
  44.     {
  45.         printf "%s %s\n", $e->at("a")->attr("href"), $e->at("span")->attr("title");
  46.         push @$ref, {
  47.                 'link' => $main . $e->at("a")->attr("href"),  
  48.                 'title' => $e->at("span")->attr("title")
  49.                 }
  50.     }

  51.     if ( defined $dom->at("#pageNext") ) { return 1 }
  52.     else {  return 0 }
  53. }

  54. # --- Get each pages of item --- #

  55. sub get_pages
  56. {
  57.     our @headers;
  58.     my ($link, $title) = @_;
  59.     my $res = $ua->get( $link, @headers );
  60.     my $dom = Mojo::DOM->new( $res->content );

  61.     my $path = "${wdir}/${title}";
  62.     mkpath $path unless -e $path;
  63.     chdir $path;

  64.     # 图片数量
  65.     my $pics = $dom->at(".photo-list-box li i")->text;
  66.     $pics=~s/[^\d]//;  #去除斜杠

  67.     my [url=home.php?mod=space&uid=20008322]@files[/url] = glob "*.jpg";
  68.     if ( $#files+1 == $pics ) {
  69.         printf "Images already exist\n";
  70.         return;
  71.     }

  72.     for my $e ($dom->find(".photo-list-box a")->each )
  73.     {
  74.         #printf "%s\n", $e->attr("href");
  75.         get_pic( $main . $e->attr("href") );
  76.     }
  77. }

  78. sub get_pic
  79. {
  80.     my ( $link ) = @_;
  81.     # 刷新 UserAgent 对象
  82.     my $ua = LWP::UserAgent->new( timeout => 6 );
  83.     my $res = $ua->get($link);
  84.     my $dom = Mojo::DOM->new($res->content);
  85.     my $pic_url;
  86.     my $pic_name;

  87.     my $sub_url = $dom->at(".wallpaper-down dd a")->attr("href");
  88.     $pic_name = basename($sub_url);
  89.     $pic_name =~ s/\.html/\.jpg/i;
  90.     printf "%s\n", $pic_name;

  91.     return if ( -e $pic_name );

  92.     my $retry = 0;
  93.     do
  94.     {
  95.         $res = $ua->get( "${main}${sub_url}" );
  96.         if    ( $retry > 0 and $retry < 5 ) { print "retry times: $retry\n"; }
  97.         elsif ( $retry > 5 )                { print "False\n"; return }   
  98.         $retry++;
  99.     }
  100.     until ( $res->is_success );

  101.     $dom = Mojo::DOM->new( $res->content );
  102.     $ua->mirror( $dom->at("")->attr("src"), $pic_name );
  103. }
复制代码

论坛徽章:
11
子鼠
日期:2014-10-11 16:46:4815-16赛季CBA联赛之山东
日期:2017-11-10 14:32:142016科比退役纪念章
日期:2017-09-02 15:42:4715-16赛季CBA联赛之佛山
日期:2017-08-28 17:11:5515-16赛季CBA联赛之浙江
日期:2017-08-24 16:55:1715-16赛季CBA联赛之青岛
日期:2017-08-17 19:55:2415-16赛季CBA联赛之天津
日期:2017-06-29 10:34:4315-16赛季CBA联赛之四川
日期:2017-05-16 16:38:55黑曼巴
日期:2016-07-19 15:03:112015亚冠之萨济拖拉机
日期:2015-05-22 11:38:532016科比退役纪念章
日期:2018-03-16 10:24:05
发表于 2018-11-07 09:11 |显示全部楼层
本帖最后由 523066680 于 2018-11-07 09:17 编辑

改了一下,用Mojo::UserAgent,默认keep_alive,连header都不用提供,速度快好多


  1. =info
  2.     Author: 523066680/vicyang
  3.     Date: 2018-11
  4. =cut

  5. use Encode;
  6. use Mojo::UserAgent;
  7. use File::Slurp;
  8. use File::Basename qw/basename/;
  9. use File::Path qw/mkpath/;
  10. STDOUT->autoflush(1);

  11. our $theme = "meishi";
  12. our $wdir = "D:/Wallpaper/zol/$theme";
  13. our $main = "http://desk.zol.com.cn";
  14. our $ua = Mojo::UserAgent->new();
  15. our @headers = (
  16.         "Host" => "desk.zol.com.cn",
  17.         "User-Agent" => "Firefox/63.0",
  18.     );

  19. mkpath $wdir unless -e $wdir;
  20. chdir $wdir;

  21. # 获取所有主题链接
  22. my @items;
  23. my $iter = 1;
  24. while ( get_item( $main ."/${theme}/${iter}.html", \@items ) >= 1 )
  25. {
  26.     $iter++;
  27. }

  28. # 遍历页面、提取图片
  29. my $idx = 1;
  30. for my $item ( @items )
  31. {
  32.     printf "[%03d/%d] %s %s\n",  $idx++ , $#items+1, $item->{link}, $item->{title};
  33.     get_pages( $item->{link}, $item->{title} );
  34. }

  35. sub get_item
  36. {
  37.     my ( $link, $ref ) = @_;
  38.     my $res = $ua->get( $link )->result;
  39.     my $dom = $res->dom;

  40.     for my $e ( $dom->find(".photo-list-padding")->each )
  41.     {
  42.         printf "%s %s\n", $e->at("a")->attr("href"), $e->at("span")->attr("title");
  43.         push @$ref, {'link'  => $main . $e->at("a")->attr("href"),
  44.                      'title' => $e->at("span")->attr("title") };
  45.     }
  46.     # 判断是否为最后一页
  47.     if ( defined $dom->at("#pageNext") ) { return 1 }
  48.     else {  return 0 }
  49. }

  50. # --- Get each pages of item --- #

  51. sub get_pages
  52. {
  53.     my ($link, $title) = @_;
  54.     my $res = $ua->get( $link )->result;
  55.     my $dom = $res->dom;

  56.     my $path = "${wdir}/${title}";
  57.     mkpath $path unless -e $path;
  58.     chdir $path;

  59.     # 图片数量
  60.     my $pics = $dom->at(".photo-list-box li i")->text;
  61.     $pics=~s/[^\d]//;  #去除斜杠

  62.     my @files = glob "*.jpg";
  63.     if ( $#files+1 == $pics ) {
  64.         printf "Images already exist\n";
  65.         return;
  66.     }

  67.     for my $e ($dom->find(".photo-list-box a")->each )
  68.     {
  69.         #printf "%s\n", $e->attr("href");
  70.         get_pic( $main . $e->attr("href") );
  71.     }
  72. }

  73. sub get_pic
  74. {
  75.     my ( $link ) = @_;
  76.     my $res = $ua->get( $link )->result;
  77.     return unless (defined $res);

  78.     my $dom = $res->dom;
  79.     my $pic_url;
  80.     my $pic_name;

  81.     my $obj = $dom->at(".wallpaper-down dd a");
  82.     my $sub_url;

  83.     while (1)
  84.     {
  85.         $sub_url = $obj->attr("href");
  86.         # 某些图片没有提供指定分辨率的链接
  87.         if ( $sub_url !~/\.html/ ) {
  88.             printf "Did not found picture url, skip %s\n", $sub_url;
  89.             return;
  90.         }

  91.         $pic_name = basename($sub_url);
  92.         $pic_name =~ s/\.html/\.jpg/i;
  93.         printf "%s\n", $pic_name;
  94.         return if ( -e $pic_name );

  95.         my $res = $ua->get( $main .$sub_url )->result;
  96.         return unless (defined $res);

  97.         my $dom = $res->dom;
  98.         my $res = $ua->get( $dom->at("")->attr("src") )->result;
  99.         
  100.         # 如果下载失败就选择下一个分辨率的图片
  101.         if ( $res->code == 502 ) { $obj = $obj->next; next; }

  102.         write_file( $pic_name, {binmode=>":raw"}, $res->body );
  103.         last;            
  104.     }
  105. }

复制代码

评分

参与人数 1信誉积分 +10 收起 理由
hztj2005 + 10 很给力!

查看全部评分

您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

数据风云,十年变迁
DTCC 第十届中国数据库技术大会已启航!

2019年5月8日~5月10日,由IT168旗下ITPUB企业社区平台主办的第十届中国数据库技术大会(DTCC2019),将在北京隆重召开。大会将邀请百余位行业专家,就热点技术话题进行分享,是广大数据领域从业人士的又一次年度盛会和交流平台。与SACC2018类似,本届大会将采用“3+2”模式:3天传统技术演讲+2天深度主题培训。大会不仅提供超100场的主题演讲,还会提供连续2天的深度课程培训,深化数据领域的项目落地实践方案。
DTCC2019,一场值得期待的数据技术盛会,殷切地希望您报名参与!

活动入口>>
  

北京盛拓优讯信息技术有限公司. 版权所有 16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122
中国互联网协会会员  联系我们:huangweiwei@it168.com
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP