[Perl]批量下载美女壁纸（ZOL桌面壁纸）

523066680

最近需要素材便写了，没有加入多线程，就这样按顺序抓～
如果因为某种原因中断了，重新开始，会判断已完成的部分节省时间。

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

运行环境： Straberry Perl 5.24

1. =info
   
2.     Author: 523066680/vicyang
   
3.     Date: 2018-11
   
4. =cut
   
5. 
   
6. use Encode;
   
7. use LWP::UserAgent;
   
8. use Mojo::DOM;
   
9. use File::Slurp;
   
10. use File::Basename qw/basename/;
    
11. use File::Path qw/mkpath/;
    
12. STDOUT->autoflush(1);
    
13. 
    
14. our $wdir = "D:/temp/wallpaper_zol/meinv";
    
15. our $main = "http://desk.zol.com.cn";
    
16. my $ua = LWP::UserAgent->new( agent => "Mozilla/5.0" );
    
17. our @headers = (
    
18.         "Host" => "desk.zol.com.cn",
    
19.         "User-Agent" => "Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:63.0) Gecko/20100101 Firefox/63.0",
    
20.     );
    
21. 
    
22. mkpath $wdir unless -e $wdir;
    
23. chdir $wdir;
    
24. 
    
25. # 获取所有主题链接
    
26. my @items;
    
27. my $iter = 1;
    
28. while ( get_item( $main ."/meinv/${iter}.html", \@items ) >= 1 )
    
29. {
    
30.     $iter++;
    
31. }
    
32. 
    
33. # 遍历页面、提取图片
    
34. my $idx = 0;
    
35. for my $item ( @items )
    
36. {
    
37.     printf "[%03d/%d] %s %s\n",  $idx++ , $#items+1, $item->{link}, $item->{title};
    
38.     get_pages( $item->{link}, $item->{title} );
    
39. }
    
40. 
    
41. sub get_item
    
42. {
    
43.     our ($main, @headers);
    
44.     my ( $link, $ref ) = @_;
    
45.     # 重建 UserAgent 对象
    
46.     my $ua = LWP::UserAgent->new();
    
47.     my $res = $ua->get($link, @headers);
    
48.     my $dom = Mojo::DOM->new( $res->content );
    
49. 
    
50.     for my $e ( $dom->find(".photo-list-padding")->each )
    
51.     {
    
52.         printf "%s %s\n", $e->at("a")->attr("href"), $e->at("span")->attr("title");
    
53.         push @$ref, {
    
54.                 'link' => $main . $e->at("a")->attr("href"),  
    
55.                 'title' => $e->at("span")->attr("title")
    
56.                 }
    
57.     }
    
58. 
    
59.     if ( defined $dom->at("#pageNext") ) { return 1 }
    
60.     else {  return 0 }
    
61. }
    
62. 
    
63. # --- Get each pages of item --- #
    
64. 
    
65. sub get_pages
    
66. {
    
67.     our @headers;
    
68.     my ($link, $title) = @_;
    
69.     my $res = $ua->get( $link, @headers );
    
70.     my $dom = Mojo::DOM->new( $res->content );
    
71. 
    
72.     my $path = "${wdir}/${title}";
    
73.     mkpath $path unless -e $path;
    
74.     chdir $path;
    
75. 
    
76.     # 图片数量
    
77.     my $pics = $dom->at(".photo-list-box li i")->text;
    
78.     $pics=~s/[^\d]//;  #去除斜杠
    
79. 
    
80.     my [url=home.php?mod=space&uid=20008322]@files[/url] = glob "*.jpg";
    
81.     if ( $#files+1 == $pics ) {
    
82.         printf "Images already exist\n";
    
83.         return;
    
84.     }
    
85. 
    
86.     for my $e ($dom->find(".photo-list-box a")->each )
    
87.     {
    
88.         #printf "%s\n", $e->attr("href");
    
89.         get_pic( $main . $e->attr("href") );
    
90.     }
    
91. }
    
92. 
    
93. sub get_pic
    
94. {
    
95.     my ( $link ) = @_;
    
96.     # 刷新 UserAgent 对象
    
97.     my $ua = LWP::UserAgent->new( timeout => 6 );
    
98.     my $res = $ua->get($link);
    
99.     my $dom = Mojo::DOM->new($res->content);
    
100.     my $pic_url;
     
101.     my $pic_name;
     
102. 
     
103.     my $sub_url = $dom->at(".wallpaper-down dd a")->attr("href");
     
104.     $pic_name = basename($sub_url);
     
105.     $pic_name =~ s/\.html/\.jpg/i;
     
106.     printf "%s\n", $pic_name;
     
107. 
     
108.     return if ( -e $pic_name );
     
109. 
     
110.     my $retry = 0;
     
111.     do
     
112.     {
     
113.         $res = $ua->get( "${main}${sub_url}" );
     
114.         if    ( $retry > 0 and $retry < 5 ) { print "retry times: $retry\n"; }
     
115.         elsif ( $retry > 5 )                { print "False\n"; return }   
     
116.         $retry++;
     
117.     }
     
118.     until ( $res->is_success );
     
119. 
     
120.     $dom = Mojo::DOM->new( $res->content );
     
121.     $ua->mirror( $dom->at("")->attr("src"), $pic_name );
     
122. }

复制代码

523066680

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

1. =info
   
2.     Author: 523066680/vicyang
   
3.     Date: 2018-11
   
4. =cut
   
5. 
   
6. use Encode;
   
7. use Mojo::UserAgent;
   
8. use File::Slurp;
   
9. use File::Basename qw/basename/;
   
10. use File::Path qw/mkpath/;
    
11. STDOUT->autoflush(1);
    
12. 
    
13. our $theme = "meishi";
    
14. our $wdir = "D:/Wallpaper/zol/$theme";
    
15. our $main = "http://desk.zol.com.cn";
    
16. our $ua = Mojo::UserAgent->new();
    
17. our @headers = (
    
18.         "Host" => "desk.zol.com.cn",
    
19.         "User-Agent" => "Firefox/63.0",
    
20.     );
    
21. 
    
22. mkpath $wdir unless -e $wdir;
    
23. chdir $wdir;
    
24. 
    
25. # 获取所有主题链接
    
26. my @items;
    
27. my $iter = 1;
    
28. while ( get_item( $main ."/${theme}/${iter}.html", \@items ) >= 1 )
    
29. {
    
30.     $iter++;
    
31. }
    
32. 
    
33. # 遍历页面、提取图片
    
34. my $idx = 1;
    
35. for my $item ( @items )
    
36. {
    
37.     printf "[%03d/%d] %s %s\n",  $idx++ , $#items+1, $item->{link}, $item->{title};
    
38.     get_pages( $item->{link}, $item->{title} );
    
39. }
    
40. 
    
41. sub get_item
    
42. {
    
43.     my ( $link, $ref ) = @_;
    
44.     my $res = $ua->get( $link )->result;
    
45.     my $dom = $res->dom;
    
46. 
    
47.     for my $e ( $dom->find(".photo-list-padding")->each )
    
48.     {
    
49.         printf "%s %s\n", $e->at("a")->attr("href"), $e->at("span")->attr("title");
    
50.         push @$ref, {'link'  => $main . $e->at("a")->attr("href"),
    
51.                      'title' => $e->at("span")->attr("title") };
    
52.     }
    
53.     # 判断是否为最后一页
    
54.     if ( defined $dom->at("#pageNext") ) { return 1 }
    
55.     else {  return 0 }
    
56. }
    
57. 
    
58. # --- Get each pages of item --- #
    
59. 
    
60. sub get_pages
    
61. {
    
62.     my ($link, $title) = @_;
    
63.     my $res = $ua->get( $link )->result;
    
64.     my $dom = $res->dom;
    
65. 
    
66.     my $path = "${wdir}/${title}";
    
67.     mkpath $path unless -e $path;
    
68.     chdir $path;
    
69. 
    
70.     # 图片数量
    
71.     my $pics = $dom->at(".photo-list-box li i")->text;
    
72.     $pics=~s/[^\d]//;  #去除斜杠
    
73. 
    
74.     my @files = glob "*.jpg";
    
75.     if ( $#files+1 == $pics ) {
    
76.         printf "Images already exist\n";
    
77.         return;
    
78.     }
    
79. 
    
80.     for my $e ($dom->find(".photo-list-box a")->each )
    
81.     {
    
82.         #printf "%s\n", $e->attr("href");
    
83.         get_pic( $main . $e->attr("href") );
    
84.     }
    
85. }
    
86. 
    
87. sub get_pic
    
88. {
    
89.     my ( $link ) = @_;
    
90.     my $res = $ua->get( $link )->result;
    
91.     return unless (defined $res);
    
92. 
    
93.     my $dom = $res->dom;
    
94.     my $pic_url;
    
95.     my $pic_name;
    
96. 
    
97.     my $obj = $dom->at(".wallpaper-down dd a");
    
98.     my $sub_url;
    
99. 
    
100.     while (1)
     
101.     {
     
102.         $sub_url = $obj->attr("href");
     
103.         # 某些图片没有提供指定分辨率的链接
     
104.         if ( $sub_url !~/\.html/ ) {
     
105.             printf "Did not found picture url, skip %s\n", $sub_url;
     
106.             return;
     
107.         }
     
108. 
     
109.         $pic_name = basename($sub_url);
     
110.         $pic_name =~ s/\.html/\.jpg/i;
     
111.         printf "%s\n", $pic_name;
     
112.         return if ( -e $pic_name );
     
113. 
     
114.         my $res = $ua->get( $main .$sub_url )->result;
     
115.         return unless (defined $res);
     
116. 
     
117.         my $dom = $res->dom;
     
118.         my $res = $ua->get( $dom->at("")->attr("src") )->result;
     
119.         
     
120.         # 如果下载失败就选择下一个分辨率的图片
     
121.         if ( $res->code == 502 ) { $obj = $obj->next; next; }
     
122. 
     
123.         write_file( $pic_name, {binmode=>":raw"}, $res->body );
     
124.         last;            
     
125.     }
     
126. }
     
127. 
     

复制代码