{"id":52091,"date":"2025-08-11T10:35:46","date_gmt":"2025-08-11T02:35:46","guid":{"rendered":"https:\/\/www.wsisp.com\/helps\/52091.html"},"modified":"2025-08-11T10:35:46","modified_gmt":"2025-08-11T02:35:46","slug":"%e5%9f%ba%e4%ba%8emojo%e4%b8%8emechanize%e7%9a%84perl%e9%ab%98%e6%95%88%e7%88%ac%e8%99%ab%e5%ae%9e%e7%8e%b0","status":"publish","type":"post","link":"https:\/\/www.wsisp.com\/helps\/52091.html","title":{"rendered":"\u57fa\u4e8eMojo\u4e0eMechanize\u7684Perl\u9ad8\u6548\u722c\u866b\u5b9e\u73b0"},"content":{"rendered":"

Perl \u867d\u7136\u4e0d\u50cf Python \u90a3\u6837\u662f\u5f53\u4eca\u722c\u866b\u9886\u57df\u7684\u7edd\u5bf9\u4e3b\u6d41，\u4f46\u5b83\u51ed\u501f\u5176\u72ec\u7279\u7684\u4f18\u52bf，\u5728\u7279\u5b9a\u573a\u666f\u4e0b\u4e0e\u722c\u866b\u7ed3\u5408\u80fd\u78b0\u649e\u51fa\u975e\u5e38\u60ca\u8273\u7684\u706b\u82b1，\u5c24\u5176\u662f\u5728\u6587\u672c\u5904\u7406\u3001\u5feb\u901f\u539f\u578b\u3001\u7cfb\u7edf\u96c6\u6210\u548c\u9057\u7559\u7cfb\u7edf\u7ef4\u62a4\u65b9\u9762\u3002<\/p>\n

\"\u5728\u8fd9\u91cc\u63d2\u5165\u56fe\u7247\u63cf\u8ff0\"<\/p>\n

\u4ee5\u4e0b\u662f\u4e00\u4e2a\u5229\u7528Perl\u7279\u6027\u5b9e\u73b0\u7684\u722c\u866b\u793a\u4f8b，\u878d\u5408\u4e86\u6b63\u5219\u8868\u8fbe\u5f0f\u5a01\u529b\u3001Mojo\u73b0\u4ee3\u5de5\u5177\u94fe\u3001Mechanize\u81ea\u52a8\u5316\u548c\u7ba1\u9053\u5904\u7406\u7b49\u7279\u8272\u529f\u80fd：<\/p>\n

#!\/usr\/bin\/env perl<\/span>
\nuse<\/span> strict;<\/span>
\nuse<\/span> warnings;<\/span>
\nuse<\/span> Mojo:<\/span>:<\/span>UserAgent;<\/span>
\nuse<\/span> Mojo:<\/span>:<\/span>DOM;<\/span>
\nuse<\/span> WWW:<\/span>:<\/span>Mechanize;<\/span>
\nuse<\/span> Text:<\/span>:<\/span>Table;<\/span> # \u751f\u6210\u8868\u683c\u8f93\u51fa<\/span>
\nuse<\/span> File:<\/span>:<\/span>Slurp;<\/span> # \u7b80\u6d01\u6587\u4ef6\u64cd\u4f5c<\/span><\/p>\n

# \u7279\u82721: Mojo\u5f02\u6b65\u5e76\u53d1\u722c\u53d6<\/span>
\nsub<\/span> mojo_concurrent_crawl<\/span> {<\/span>
\n my<\/span> $ua<\/span> =<\/span> Mojo:<\/span>:<\/span>UserAgent-><\/span>new(<\/span>max_redirects =><\/span> 3<\/span>)<\/span>;<\/span>
\n $ua<\/span>-><\/span>transactor-><\/span>name(<\/span>'Mozilla\/5.0 (Windows NT 10.0; rv:91.0) Gecko\/20100101 Firefox\/91.0'<\/span>)<\/span>;<\/span><\/p>\n

# \u521b\u5efa\u5f02\u6b65\u91c7\u96c6\u961f\u5217<\/span>
\n my<\/span> @urls<\/span> =<\/span> (<\/span>
\n 'https:\/\/news.ycombinator.com'<\/span>,<\/span>
\n 'https:\/\/www.perl.org'<\/span>,<\/span>
\n 'https:\/\/github.com\/topics\/perl'<\/span>
\n )<\/span>;<\/span><\/p>\n

# \u7279\u82722: \u4f7f\u7528->ioloop\u5b9e\u73b0\u5e76\u53d1\u63a7\u5236<\/span>
\n my<\/span> $delay<\/span> =<\/span> Mojo:<\/span>:<\/span>Promise-><\/span>new;<\/span>
\n my<\/span> $count<\/span> =<\/span> 0<\/span>;<\/span><\/p>\n

for<\/span> my<\/span> $url<\/span> (<\/span>@urls<\/span>)<\/span> {<\/span>
\n my<\/span> $promise<\/span> =<\/span> $ua<\/span>-><\/span>get_p(<\/span>$url<\/span>)<\/span>-><\/span>then(<\/span>sub<\/span> {<\/span>
\n my<\/span> (<\/span>$tx<\/span>)<\/span> =<\/span> @_<\/span>;<\/span><\/p>\n

# \u7279\u82723: Mojo::DOM\u7684CSS\u9009\u62e9\u5668<\/span>
\n my<\/span> $dom<\/span> =<\/span> $tx<\/span>-><\/span>result-><\/span>dom;<\/span>
\n print<\/span> "\u2605 \u6765\u81ea "<\/span> .<\/span> $tx<\/span>-><\/span>req-><\/span>url-><\/span>host .<\/span> " \u7684\u6807\u9898:\\\\n"<\/span>;<\/span><\/p>\n

# \u7279\u82724: Perl\u7279\u6709\u7684map\u94fe\u5f0f\u5904\u7406<\/span>
\n my<\/span> @titles<\/span> =<\/span> $dom<\/span>-><\/span>find(<\/span>'h1, h2, h3'<\/span>)<\/span>-><\/span>map(<\/span>'text'<\/span>)<\/span>-><\/span>grep(<\/span>qr\/perl\/i<\/span>)<\/span>-><\/span>uniq-><\/span>each;<\/span>
\n print<\/span> " $_\\\\n"<\/span> for<\/span> @titles<\/span>;<\/span><\/p>\n

# \u7279\u82725: \u5f3a\u5927\u7684\u6b63\u5219\u8868\u8fbe\u5f0f\u63d0\u53d6<\/span>
\n $dom<\/span>-><\/span>find(<\/span>'a'<\/span>)<\/span>-><\/span>each(<\/span>sub<\/span> {<\/span>
\n my<\/span> (<\/span>$e<\/span>)<\/span> =<\/span> @_<\/span>;<\/span>
\n if<\/span> (<\/span>$e<\/span>-><\/span>attr(<\/span>'href'<\/span>)<\/span> =~<\/span> m{
\n \\\\.(pdf|ppt|docx?) # \u6355\u83b7\u6587\u6863\u7c7b\u578b
\n (?:\\\\?.*)?$ # \u5ffd\u7565\u67e5\u8be2\u53c2\u6570
\n }six<\/span>)<\/span> {<\/span>
\n print<\/span> " \u53d1\u73b0\u6587\u6863: "<\/span> .<\/span> $e<\/span>-><\/span>attr(<\/span>'href'<\/span>)<\/span> .<\/span> "\\\\n"<\/span>;<\/span>
\n }<\/span>
\n }<\/span>)<\/span>;<\/span>
\n }<\/span>)<\/span>-><\/span>catch(<\/span>sub<\/span> {<\/span>
\n my<\/span> $err<\/span> =<\/span> shift;<\/span>
\n warn "🚨 $url \u8bf7\u6c42\u5931\u8d25: $err"<\/span>;<\/span>
\n }<\/span>)<\/span>;<\/span><\/p>\n

$delay<\/span> =<\/span> $delay<\/span>-><\/span>then(<\/span>$promise<\/span>)<\/span>;<\/span>
\n last<\/span> if<\/span> ++<\/span>$count<\/span> >=<\/span> 5<\/span>;<\/span> # \u9650\u5236\u5e76\u53d1\u6570<\/span>
\n }<\/span><\/p>\n

$delay<\/span>-><\/span>wait;<\/span>
\n}<\/span><\/p>\n

# \u7279\u82726: Mechanize\u8868\u5355\u4ea4\u4e92\u5f0f\u722c\u53d6<\/span>
\nsub<\/span> mech_form_crawler<\/span> {<\/span>
\n my<\/span> $mech<\/span> =<\/span> WWW:<\/span>:<\/span>Mechanize-><\/span>new(<\/span>autosave =><\/span> 1<\/span>)<\/span>;<\/span>
\n $mech<\/span>-><\/span>agent_alias(<\/span>'Windows Chrome'<\/span>)<\/span>;<\/span><\/p>\n

$mech<\/span>-><\/span>get(<\/span>'https:\/\/example.com\/login'<\/span>)<\/span>;<\/span><\/p>\n

# \u7279\u82727: \u667a\u80fd\u8868\u5355\u586b\u5199<\/span>
\n $mech<\/span>-><\/span>submit_form(<\/span>
\n form_number =><\/span> 1<\/span>,<\/span>
\n fields =><\/span> {<\/span>
\n username =><\/span> 'perl_bot'<\/span>,<\/span>
\n password =><\/span> 'camel_123'<\/span>
\n }<\/span>,<\/span>
\n )<\/span>;<\/span><\/p>\n

# \u7279\u82728: \u94fe\u63a5\u8fc7\u6ee4\u91c7\u96c6<\/span>
\n my<\/span> @links<\/span> =<\/span> $mech<\/span>-><\/span>find_all_links(<\/span>url_regex =><\/span> qr\/archive\/<\/span>)<\/span>;<\/span>
\n for<\/span> my<\/span> $link<\/span> (<\/span>@links<\/span>)<\/span> {<\/span>
\n next<\/span> unless<\/span> $link<\/span>-><\/span>url =~<\/span> m{\/202[34]\/}<\/span>;<\/span> # \u6b63\u5219\u8fc7\u6ee4<\/span><\/p>\n

$mech<\/span>-><\/span>get(<\/span>$link<\/span>-><\/span>url)<\/span>;<\/span>
\n my<\/span> $content<\/span> =<\/span> $mech<\/span>-><\/span>content;<\/span><\/p>\n

# \u7279\u82729: \u591a\u884c\u6b63\u5219\u63d0\u53d6<\/span>
\n if<\/span> (<\/span>$content<\/span> =~<\/span> m{
\n <div\\\\s+class="article"> # \u5f00\u59cb\u6807\u8bb0
\n (.*?) # \u60f0\u6027\u5339\u914d\u5185\u5bb9
\n <\/div> # \u7ed3\u675f\u6807\u8bb0
\n }xms<\/span>)<\/span> {<\/span>
\n my<\/span> $article<\/span> =<\/span> $1<\/span>;<\/span><\/p>\n

# \u7279\u827210: \u5c31\u5730\u5185\u5bb9\u6e05\u6d17<\/span>
\n $article<\/span> =~<\/span> s\/<script.*?<\\\\\/script>\/\/gs<\/span>;<\/span> # \u5220\u9664\u811a\u672c<\/span>
\n $article<\/span> =~<\/span> s\/<[^>]+>\/\/g<\/span>;<\/span> # \u79fb\u9664\u6240\u6709\u6807\u7b7e<\/span>
\n $article<\/span> =~<\/span> s\/\\\\s{2,}\/ \/g<\/span>;<\/span> # \u538b\u7f29\u7a7a\u767d<\/span><\/p>\n

# \u4fdd\u5b58\u5904\u7406\u7ed3\u679c<\/span>
\n write_file(<\/span>"data\/"<\/span>.<\/span>time(<\/span>)<\/span>.<\/span>".txt"<\/span>,<\/span> {<\/span>binmode =><\/span> ':utf8'<\/span>}<\/span>,<\/span> $article<\/span>)<\/span>;<\/span>
\n }<\/span>
\n }<\/span>
\n}<\/span><\/p>\n

# \u7279\u827211: \u7ba1\u9053\u5f0f\u6570\u636e\u5904\u7406<\/span>
\nsub<\/span> pipeline_processing<\/span> {<\/span>
\n open my<\/span> $pipe<\/span>,<\/span> '|-'<\/span>,<\/span> 'grep "Perl" | sort | uniq -c | head -n 20'<\/span> or<\/span> die<\/span> $!<\/span>;<\/span><\/p>\n

my<\/span> @sites<\/span> =<\/span> qw(
\n https:\/\/www.reddit.com\/r\/perl
\n https:\/\/stackoverflow.com\/questions\/tagged\/perl
\n )<\/span>;<\/span><\/p>\n

my<\/span> $ua<\/span> =<\/span> Mojo:<\/span>:<\/span>UserAgent-><\/span>new;<\/span>
\n foreach<\/span> my<\/span> $url<\/span> (<\/span>@sites<\/span>)<\/span> {<\/span>
\n my<\/span> $tx<\/span> =<\/span> $ua<\/span>-><\/span>get(<\/span>$url<\/span>)<\/span>;<\/span>
\n my<\/span> $text<\/span> =<\/span> $tx<\/span>-><\/span>result-><\/span>text;<\/span><\/p>\n

# \u7279\u827212: \u4e00\u884c\u5f0f\u6b63\u5219\u63d0\u53d6<\/span>
\n my<\/span> @matches<\/span> =<\/span> $text<\/span> =~<\/span> \/(\\\\b\\\\w*perl\\\\w*\\\\b)\/gi<\/span>;<\/span><\/p>\n

print<\/span> $pipe<\/span> "$_\\\\n"<\/span> for<\/span> @matches<\/span>;<\/span>
\n }<\/span>
\n close $pipe<\/span>;<\/span>
\n}<\/span><\/p>\n

# \u6267\u884c\u793a\u4f8b<\/span>
\nmojo_concurrent_crawl(<\/span>)<\/span>;<\/span><\/p>\n

Perl\u722c\u866b\u7279\u8272\u89e3\u6790：<\/h4>\n

1\u3001\u6b63\u5219\u8868\u8fbe\u5f0f\u6838\u6b66\u5668：<\/p>\n

$article<\/span> =~<\/span> s\/<script.*?<\\\\\/script>\/\/gs<\/span>;<\/span> # \u7cbe\u51c6\u6e05\u9664\u811a\u672c\u6807\u7b7e<\/span>
\n$link<\/span>-><\/span>url =~<\/span> m{\/202[34]\/}<\/span> # \u8def\u5f84\u667a\u80fd\u8fc7\u6ee4<\/span><\/p>\n

2\u3001Mojo\u73b0\u4ee3\u5de5\u5177\u94fe：<\/p>\n

$ua<\/span>-><\/span>get_p(<\/span>$url<\/span>)<\/span>-><\/span>then(<\/span>sub<\/span> {<\/span>…<\/span>}<\/span>)<\/span> # Promise\u5f02\u6b65\u5904\u7406<\/span>
\n$dom<\/span>-><\/span>find(<\/span>'h1'<\/span>)<\/span>-><\/span>map(<\/span>'text'<\/span>)<\/span>-><\/span>grep(<\/span>qr\/perl\/i<\/span>)<\/span> # \u94fe\u5f0f\u9009\u62e9\u5668<\/span><\/p>\n

3\u3001Mechanize\u81ea\u52a8\u5316：<\/p>\n

$mech<\/span>-><\/span>submit_form(<\/span> # \u81ea\u52a8\u8868\u5355\u63d0\u4ea4<\/span>
\n fields =><\/span> {<\/span>username =><\/span> 'bot'<\/span>}<\/span>
\n)<\/span>;<\/span><\/p>\n

4\u3001UNIX\u7ba1\u9053\u96c6\u6210：<\/p>\n

open my<\/span> $pipe<\/span>,<\/span> '|-'<\/span>,<\/span> 'grep "Perl" | sort | uniq -c'<\/span>;<\/span> # \u76f4\u63a5\u8c03\u7528\u7cfb\u7edf\u7ba1\u9053<\/span><\/p>\n

5\u3001\u547d\u4ee4\u884c\u9b54\u6cd5： \u5355\u884c\u6293\u53d6\u793a\u4f8b：<\/p>\n

perl -MLWP::Simple -e 'getprint "https:\/\/example.com"'<\/span> |<\/span> perl -nE '\/<title>(.*?)<\/ && say $1<\/span>'<\/span><\/p>\n

6\u3001\u667a\u80fd\u5185\u5bb9\u63d0\u53d6：<\/p>\n

# \u591a\u884c\u8de8\u884c\u5339\u914d<\/span>
\n$content<\/span> =~<\/span> m{<div class="article">(.*?)<\/div>}xms<\/span>;<\/span><\/p>\n

7\u3001\u9632\u5fa1\u5f0f\u7f16\u7a0b：<\/p>\n

$ua<\/span>-><\/span>max_redirects(<\/span>3<\/span>)<\/span>;<\/span> # \u9632\u91cd\u5b9a\u5411\u9677\u9631<\/span>
\n$mech<\/span>-><\/span>autosave(<\/span>1<\/span>)<\/span>;<\/span> # \u81ea\u52a8\u4fdd\u5b58\u4f1a\u8bdd<\/span><\/p>\n

\u5178\u578b\u5e94\u7528\u573a\u666f：<\/h4>\n