• 习近平要求把这项工作作为重大政治任务 2019-03-24
  • 充分发挥重要平台和有效载体作用 以特色小镇建设促进乡村振兴 2019-03-18
  • 脸每天都洗,但你真的洗对了吗? 2019-03-18
  • 港珠澳大桥珠海口岸停车场智慧停车系统启用在即 2019-03-14
  • 以实际行动诠释忠诚 以实干实政维护核心 2019-03-14
  • 天津市津南区严打校园周边“五毛食品” 2019-03-11
  • 设计众议院:新时代消费观念造就的全新第八代凯美瑞 2019-03-11
  • 补时绝杀!英格兰2-1突尼斯 凯恩梅开二度 2019-03-09
  • 我和党报党网有个约会在线征集活动 2019-03-09
  • 吃饭刷脸 还有多远? 2019-03-07
  • 中共中央文件选集一(1921―1925) 2019-03-05
  • 《中国气候变化蓝皮书》:年平均气温显著上升 2019-03-05
  • 这样的银行就应该倒闭 2019-03-01
  • 有兴趣的朋友可以去看咱的《机器人普及时代的生产关系》…… 2019-03-01
  • 中国欲举办2030年世界杯?网友调侃:真可笑 2019-02-26
  • 批处理新手入门导读[视频教程]批处理基础视频教程[视频教程]VBS基础视频教程
    [批处理文件精品]批处理版照片整理器[批处理文件精品]纯批处理备份&还原驱动在线第三方下载
    返回列表 发帖

    甘肃十一选五的走势图:[原创代码] [Perl]批量下载美女壁纸(ZOL桌面壁纸)

    本帖最后由 523066680 于 2018-11-1 11:23 编辑

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

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

    运行环境: Straberry Perl 5.24
     广东十一选五计划软件 www.qe-ar.com 
    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 = "//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->, $item->{title};
    33.     get_pages( $item->, $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 @files = 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. }
    复制代码
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    使用 Mojo::UserAgent

    本帖最后由 523066680 于 2018-11-3 10:48 编辑

    改用Mojo::UserAgent,似乎默认keep_alive,效率高好多,这次下载“美食”系列图片

        =info
            Author: 523066680/vicyang
            Date: 2018-11
        =cut

        use Encode;
        use Mojo::UserAgent;
        use Mojo::DOM;
        use File::Slurp;
        use File::Basename qw/basename/;
        use File::Path qw/mkpath/;
        STDOUT->autoflush(1);

        our $theme = "meishi";
        our $wdir = "F:/Wallpaper/zol/$theme";
        our $main = "//desk.zol.com.cn";
        our $ua = Mojo::UserAgent->new();
        our @headers = (
                "Host" => "desk.zol.com.cn",
                "User-Agent" => "Firefox/63.0",
            );

        mkpath $wdir unless -e $wdir;
        chdir $wdir;

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

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

        sub get_item
        {
            my ( $link, $ref ) = @_;
            my $res = try_to_get( $link );
            my $dom = $res->dom;

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

        --- Get each pages of item --- #

        sub get_pages
        {
            my ($link, $title) = @_;
            my $res = try_to_get( $link );
            my $dom = $res->dom;

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

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

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

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

        sub get_pic
        {
            my ( $link ) = @_;
            my $res = try_to_get( $link );
            return unless (defined $res);

            my $dom = $res->dom;
            my $pic_url;
            my $pic_name;

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

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

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

                my $res = try_to_get( "${main}${sub_url}" );
                return unless (defined $res);

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

                write_file( $pic_name, {binmode=>":raw"}, $res->body );
                last;            
            }
        }

        sub try_to_get
        {
            our ($ua, @headers);
            my $link = shift;
            my $res;
            my $retry = 0;
            do
            {
                $res = $ua->get( $link )->result;
                if    ( $retry > 0 and $retry < 5 ) { print "Retry times: $retry\n"; }
                elsif ( $retry > 5 )                { print "False\n"; return undef }
                $retry++;
            }
            until ( $res->is_success );

            return $res;
        }
    综合型编程论坛
    Writing Code That Nobody Else Can Read.

    TOP

    返回列表
  • 习近平要求把这项工作作为重大政治任务 2019-03-24
  • 充分发挥重要平台和有效载体作用 以特色小镇建设促进乡村振兴 2019-03-18
  • 脸每天都洗,但你真的洗对了吗? 2019-03-18
  • 港珠澳大桥珠海口岸停车场智慧停车系统启用在即 2019-03-14
  • 以实际行动诠释忠诚 以实干实政维护核心 2019-03-14
  • 天津市津南区严打校园周边“五毛食品” 2019-03-11
  • 设计众议院:新时代消费观念造就的全新第八代凯美瑞 2019-03-11
  • 补时绝杀!英格兰2-1突尼斯 凯恩梅开二度 2019-03-09
  • 我和党报党网有个约会在线征集活动 2019-03-09
  • 吃饭刷脸 还有多远? 2019-03-07
  • 中共中央文件选集一(1921―1925) 2019-03-05
  • 《中国气候变化蓝皮书》:年平均气温显著上升 2019-03-05
  • 这样的银行就应该倒闭 2019-03-01
  • 有兴趣的朋友可以去看咱的《机器人普及时代的生产关系》…… 2019-03-01
  • 中国欲举办2030年世界杯?网友调侃:真可笑 2019-02-26