这个可是效率最高的爬虫

yvmu

取一个这么有吸引力的标题 主要为了介绍AE和Coro家族，爬虫只是一个小例子。

不完善的地方是URL处理函数，需要考虑的比较全面，我这里简单化了。

将代码保持到test.pl里，执行perl test.pl 'http://bbs.chinaunix.com'，就开始抓整站了。

1. #!/usr/bin/perl
   
2. 
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. use Coro;
   
7. use AnyEvent::HTTP;
   
8. use BerkeleyDB;
   
9. 
   
10. 
    
11. # 参数设置
    
12. my $limit = 10; # 异步抓取数量
    
13. 
    
14. 
    
15. # 初始化数据库
    
16. my $filename = "URLs.db";
    
17. tie my %url, 'BerkeleyDB::Btree',
    
18.     -Filename => $filename,
    
19.     -Flags    => DB_CREATE
    
20.     or die "Cannot open $filename: $! $BerkeleyDB::Error\n";
    
21. 
    
22. $filename = "Queue.db";
    
23. tie my @queue, 'BerkeleyDB::Recno',
    
24.     -Filename => $filename,
    
25.     -Flags    => DB_CREATE
    
26.     or die "Cannot open $filename: $! $BerkeleyDB::Error\n";
    
27. 
    
28. 
    
29. # 初始化进度条
    
30. my $total;
    
31. my $done;
    
32. if (exists $ARGV[0]){
    
33.     push @queue, $ARGV[0];
    
34.     $url{$ARGV[0]} = 1;
    
35.     $total         = 1;
    
36.     $done          = 0;
    
37. }else {exit 0};
    
38. 
    
39. # 间隔一段时间报一次进度
    
40. $| = 1;
    
41. my $progress = AnyEvent->timer (
    
42.     after => 0,
    
43.     interval => 1,
    
44.     cb    => sub {
    
45.         print "*当前进度：$done/$total(完成/总量)\r";
    
46.     },
    
47. );
    
48. 
    
49. 
    
50. # 异步HTTP请求
    
51. my $sem = new Coro::Semaphore $limit;
    
52. my $sig = new Coro::Signal;
    
53. $Coro::POOL_SIZE            = $limit;
    
54. 
    
55. while (1){
    
56.     if(my $url = pop @queue){     # 列队请求
    
57.         $sem->down;
    
58.         async_pool {
    
59.             my $url = shift;
    
60.             http_get $url, Coro::rouse_cb;
    
61. 
    
62.             my @res = Coro::rouse_wait;
    
63.             my $urls = &URL($url,\$res[0]);
    
64. 
    
65.             foreach (@$urls){
    
66.                 if (not exists $url{$_}){
    
67.                     push @queue, $_;
    
68.                     $url{$_} = 1;
    
69.                     $total++;
    
70.                 }
    
71.             }
    
72. 
    
73.             $done++;
    
74.             $sem->up;
    
75.             $sig->send;
    
76.         } $url;
    
77.     }elsif($sem->count < $limit){ # 等待剩余进程返回
    
78.         $sig->wait;
    
79.     }else{                        # 全部剩余进程返回，结束循环
    
80.         last;
    
81.     }
    
82. }
    
83. 
    
84. undef $progress;
    
85. print "\n抓取完成：完成$done/总量$total\n";
    
86. 
    
87. # 关闭数据库连接
    
88. untie %url;
    
89. untie @queue;
    
90. 
    
91. sub URL{
    
92.     my $base = shift;
    
93.     my $HTML = shift;
    
94.     #scheme://domain:port/path?query_string#fragment_id
    
95.     my $sdp;
    
96.     if ($base =~ m#^(\w+://[^/]+)/?#){
    
97.         $sdp = $1;
    
98.     }
    
99.     my $sdpp;
    
100.     if ($base =~ m#^(\w+://.+)/[^/]?#){
     
101.         $sdpp = $1 . '/';
     
102.     }else {$sdpp = $sdp . '/'}
     
103. 
     
104.     my @urls;
     
105.     while ($HTML =~ /<a\b([^>]+)>/ig){
     
106.         if ($1 =~ /\bhref\s*=\s*(?:"([^"]*)"|'([^']*)'|([^'">\s]+))/i){
     
107.             my $url = $+;
     
108.             next if (
     
109.                      $url =~ /^#/             ||
     
110.                      $url =~ /^javascript:;/i ||
     
111.                      $url =~ /^mailto:/i);
     
112. 
     
113.             if ($url =~ m#^http://#i && $url =~ /$sdp/){
     
114.                 push @urls, $url;
     
115.             }elsif ($url =~ m#^/[^/]#){
     
116.                 push @urls, $sdp . $url;
     
117.             }elsif ($url =~ /^\.[^.]/){
     
118.                 push @urls, $sdpp . substr $url, 2;
     
119.             }elsif ($url =~ /^\w/){
     
120.                 push @urls, $sdpp . $url;
     
121.             }#else处理异常
     
122.         }
     
123.     }
     
124. 
     
125.     return \@urls;
     
126. }
     

复制代码

huang6894

楼主，你知道py（安）thon（利）麽。。。。

yvmu

欢迎python的朋友交流，写个比较下？

yestreenstars

perl也可以写爬虫啊？涨姿势了~{:3_193:}

sjdy521

效率最高。。。。

laputa73

支持LZ.
@墨迹哥 来交流一下

iamlimeng

Windows下如何创建BerkeleyDB环境，尝试了一下没成功！

yvmu

不用BerkeleyDB也可以的，很简单，将初始化数据库的代码改成my两个同名的变量就行了。

py

终于看到有人写Coro的爬虫了。标题没写错，楼主可以发个链接到那个叫什么python的板块去

yvmu

Coro::Channel我没有思路呀，你说下模型我参考下或许可以写出来。