惯性聚合 高效追踪和阅读你感兴趣的博客、新闻、科技资讯
阅读原文 在惯性聚合中打开

推荐订阅源

V
Visual Studio Blog
博客园 - 司徒正美
博客园_首页
Jina AI
Jina AI
奇客Solidot–传递最新科技情报
奇客Solidot–传递最新科技情报
月光博客
月光博客
I
InfoQ
M
MIT News - Artificial intelligence
T
Tailwind CSS Blog
L
LangChain Blog
Last Week in AI
Last Week in AI
A
About on SuperTechFans
B
Blog
博客园 - 叶小钗
雷峰网
雷峰网
H
Help Net Security
WordPress大学
WordPress大学
大猫的无限游戏
大猫的无限游戏
博客园 - 【当耐特】
云风的 BLOG
云风的 BLOG
Microsoft Azure Blog
Microsoft Azure Blog
小众软件
小众软件
aimingoo的专栏
aimingoo的专栏
OSCHINA 社区最新新闻
OSCHINA 社区最新新闻

Perl

Perl 怀旧群 安装社区版 perl 时的注册问题 有没有业余学 perl 作为爱好的 perl 还值得学吗 来一起学习 Perl 6 阿 Perl 学习地 新手学 perl,想问一下 print 数字的时候,为什么后面总是跟着一个“%” perl 的打包部署问题 Perl 爬取内容失败 连永远的毁灭公爵都发布了 perl6还没有完工 perl6就要出来了,大家有期待的吗?
一段 perl 代码展示如何 all in one 优雅地编写一个异步爬虫
dfgddgf · 2022-09-15 · via Perl
#cpan https://cpan.metacpan.org/authors/id/S/SR/SRI/Mojolicious-7.31.tar.gz
#cpanm -n [email protected]
use feature ':5.10';
use strict;
use warnings;
use utf8;
use Mojo;
use Encode qw(decode encode);
##########################################################################
$ENV{MOJO_REACTOR} = 'Mojo::Reactor::EV';

#使用 EV 具有更好的性能
my $ua = Mojo::UserAgent->new;
$ua->inactivity_timeout(60);
$ua->connect_timeout(60);
$ua->request_timeout(60);

#适当延长超时的时间,阻止过早的 http 请求失败,会有更好的性能
$ua->max_connections(1000);

#最大连接数 1000
$ua->max_redirects(0);

#阻止 http3xx 重定向
$ua->transactor->name('Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:102.0) Gecko/20100101 Firefox/102.0');

#使用正常浏览器的 user agent
$ua->cookie_jar->ignore( sub { 1 } );
#禁用 Mojo::UserAgent 自动处理 cookie
$ua->proxy->http('http://127.0.0.1:8080')->https('http://127.0.0.1:8080');
#使用代理服务器

##########################################################################
my @list = ();

#原始队列
my @urllist = ();

#下载队列
my $n = 0;

#下载数量
my $m = 0;

#出错数量
my $produce_num = 0;

#生产者数量
my $consumer_num = 0;

#消费者数量
my $cookie_num = 0;

#cookie 数量
my @cookielist = ();

#使用的 cookie 队列
my %cookieinvalid = ();

#失效的 cookie 散列
##########################################################################
open FILEIN, '<', "./url.txt" or die "$!";
while (<FILEIN>) {
    my $content = $_;
    chomp($content);
    $content =~ s/\r//;
    push( @list, $content );
}
close FILEIN;

#导入下载列表
##########################################################################
sub append_txt_to_file {
    my $file_name = $_[0];
    my $txt       = $_[1];
    local *FH;
    open FH, '>>', $file_name;
    print FH $txt;
    close FH;
}

sub write_txt_to_file {
    my $file_name = $_[0];
    my $txt       = $_[1];
    local *FH;
    open FH, '>', $file_name;
    print FH $txt;
    close FH;
}
my %safe_character = (
    '<'  => '<',
    '>'  => '>',
    ':'  => ':',
    '"'  => '"',
    '/'  => '/',
    '\\' => '\',
    '|'  => '|',
    '?'  => '?',
    '*'  => '*',
);

sub repace_safe {
    my $per_char = $_[0];
    my $one_txt  = $_[1];
    my $output_char;
    if ( exists $safe_character{$per_char} ) {
        $output_char = $safe_character{$per_char};
    }
    else {
        $output_char = $per_char;
    }
    return $output_char;
}

sub find {
    my $html_bin = $_[0];
    my $id       = $_[1];
    if ( $html_bin =~ m/<\/html>/ ) {
        return '####';
    }
    else {
        return '@@@';
    }
}
##########################################################################
sub get_multiplex {
    my $id    = $_[0];
    my $delay = Mojo::IOLoop->delay( sub { get_multiplex($id) } );

    #get_multiplex 递归迭代的开始标记
    #$id 是每一个线程(端口的序号)
    my $end = $delay->begin;
    Mojo::IOLoop->timer( 0.1 => $delay->begin );

    #每个 http 请求前暂停 0.1s
    if ( scalar @urllist == 0 ) {
        if ( $produce_num == $consumer_num ) {
            Mojo::IOLoop->stop;

            #异步循环结束
            #当队列数量为 0 ,且所有的线程数据都处理完毕的时候,终止事件循环
            #return 存在一个递归返回链,这里可以更快地结束
        }
        return;

        #这里返回后异步任务数量为 0 时,系统会自动结束异步循环,不过速度较慢
        #return 返回闭包函数的开始,并结束闭包函数,下面不开启递归自身
    }
    else {
        my $object = shift @urllist;
        $produce_num++;
        my $url      = $object;
        my $filename = $object;
        $filename =~ s/^http:\/\/www\.bing\.com\/w\///m;
        $filename =~ s/(.)/repace_safe($1)/eg;
        $filename = "./www.bing.com/" . $filename . ".html";
        if ( -e $filename ) {
            syswrite STDERR, encode( 'utf8', $n . "\t" . $object . "\t   跳过\n" );    #STDOUT 编码已改,输送到 STDOUT 会出现错误
            $consumer_num++;
            $end->();
        }
        else {
            my $build_tx = $ua->build_tx( GET => $url );
            $build_tx->req->headers->remove('Accept-Encoding');

            #阻止网页压缩,保证更好的性能
            $build_tx->req->headers->add( 'Accept'          => 'text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,*/*;q=0.8' );
            $build_tx->req->headers->add( 'Accept-Language' => 'zh-CN,zh;q=0.8,zh-TW;q=0.7,zh-HK;q=0.5,en-US;q=0.3,en;q=0.2' );
            $ua->transactor->name( 'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:' . int( rand(900) ) . ') Gecko/' . int( rand(40000001) ) . ' Firefox/' . int( rand(900) ) . '.0' );

            #使用 2 万个 cookie
            $ua->start(
                $build_tx => sub {
                    my ( $ua, $tx ) = @_;
                    if ( !$tx->is_finished ) {
                        push( @urllist, $object );
                        syswrite STDERR, "http 传输未完成" . "\n";
                        syswrite STDERR, encode( 'utf8', $url . "\t" . $tx->error->{message} . "\n" );
                    }
                    else {
                        my $code = '';
                        $code = $tx->res->code if defined $tx->res->code;
                        if ( $code =~ /\A2/ ) {
                            my $size           = $tx->res->content->asset->size;
                            my $content_length = $tx->res->headers->to_hash->{'Content-Length'};
                            if ( ( $size == $content_length ) || !( defined $content_length ) ) {
                                my $outnum = find( $tx->res->body, $id );
                                if ( $outnum ne '@@@' ) {
                                    append_txt_to_file( "url.txt", $object . "\t" . $outnum . "\n" );
                                    write_txt_to_file( $filename, $tx->res->body );
                                    $n++;
                                    syswrite STDERR, encode( 'utf8', $n . "\t" . $object . "\n" );
                                }
                                else {
                                    $n++;
                                    syswrite STDERR, encode( 'utf8', $m . "\t" . $object . "\t 网页下载完整但未提取到数据\n" );
                                }
                            }
                            else {
                                $m++;
                                push( @urllist, $object );
                                syswrite STDERR, encode( 'utf8', $m . "\t" . $object . "\t 网页未下载完整\n" );
                            }
                        }
                        elsif ( $code =~ /\A4/ ) {
                            syswrite STDERR, encode( 'utf8', $m . "\t" . $object . "\thttp 4xx\n" );
                            push( @urllist, $object );
                            Mojo::IOLoop->timer( 0.5 => $delay->begin );

                            #http 404
                        }
                        else {
                            $m++;
                            push( @urllist, $object );
                            syswrite STDERR, encode( 'utf8', $m . "\t" . $object . "\t 未发现 http code, http 3xx, http 5xx\n" );

                            #标记失效的从 cookie http 3xx
                            Mojo::IOLoop->timer( 0.5 => $delay->begin );

                            #服务器返回 5xx ,暂停 0.5s
                            #未发现 http code, http 302, http 503
                        }
                    }
                    $consumer_num++;
                    $end->();

                    #get_multiplex 递归迭代的结束标记
                    #从这里跳转到下一个 get_multiplex
                }
            );
        }
    }
}
##########################################################################
$produce_num  = 0;
$consumer_num = 0;
@urllist      = @list;

#异步下载前的变量准备
foreach my $id ( 1 .. 50 ) { get_multiplex($id) }

#使用 50 个线程(端口)下载
#如果线程数是 100 ,限制最大 cookie 数无法生效,并且 EV 会出现错误
Mojo::IOLoop->start;

#异步循环启动
##########################################################################