下大雪不能出门，在家做了个简单的爬虫demo

撒哈拉里的鱼

主要是多线程、队列、Bloom Filter等的使用，没什么技术含量，算是个demo吧。爬行深度之类的我没加，加上也容易，几句话的事情。直接代码描述吧。我C写得多一些，所以perl代码的风格不怎么perl。

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. 
   
6. use threads;
   
7. use threads::shared;
   
8. use Thread::Queue;
   
9. use Thread::Semaphore;
   
10. 
    
11. use Bloom::Filter;
    
12. use URI::URL;
    
13. use Web::Scraper;
    
14. 
    
15. my $max_threads = 30;
    
16. my $base_url = $ARGV[0] || 'http://www.icylife.net/';
    
17. my $host = URI->new($base_url)->host;
    
18. 
    
19. my $queue = Thread::Queue->new( );
    
20. my $semaphore = Thread::Semaphore->new( $max_threads );
    
21. my $filter = shared_clone( Bloom::Filter->new(capacity => 50000, error_rate => 0.001) );
    
22. 
    
23. $queue->enqueue( $base_url );
    
24. $filter->add( $base_url );
    
25. 
    
26. while( 1 )
    
27. {
    
28.         # join all threads which can be joined
    
29.         foreach ( threads->list(threads::joinable) )
    
30.         {
    
31.                 $_->join( );
    
32.         }
    
33. 
    
34.         # if there are no url need process.
    
35.         my $item = $queue->pending();
    
36.         if( $item == 0 )
    
37.         {
    
38.                 # there are no active thread, we finish the job
    
39.                 if( threads->list(threads::running) == 0 )
    
40.                 {
    
41.                         print "All done!\n";
    
42.                         last;
    
43.                 }
    
44.                 # we will get some more url if there are some active threads, just wait for them
    
45.                 else
    
46.                 {
    
47.                         sleep 1;
    
48.                         next;
    
49.                 }
    
50.         }
    
51.        
    
52.         # if there are some url need process
    
53.         while( $semaphore->down )
    
54.         {
    
55.                 threads->create( \&ProcessUrl );
    
56.         }
    
57. }
    
58. 
    
59. # join all threads which can be joined
    
60. foreach ( threads->list() )
    
61. {
    
62.         $_->join( );
    
63. }
    
64. 
    
65. sub ProcessUrl
    
66. {
    
67.         my $scraper = scraper
    
68.         {
    
69.                 process '//a', 'links[]' => '@href';
    
70.         };
    
71. 
    
72.         my $res;
    
73.         my $link;
    
74. 
    
75.         while( my $url = $queue->dequeue_nb() )
    
76.         {
    
77.                 $res = $scraper->scrape( URI->new($url) )->{'links'};
    
78.                 #print "there are ".scalar(threads->list(threads::running))." threads, ", $queue->pending(), " urls need process.\n";
    
79. 
    
80.                 foreach( @{$res} )
    
81.                 {
    
82.                         $link = $_->as_string;
    
83.                         $link = URI::URL->new($link, $url);
    
84. 
    
85.                         # not http and not https?
    
86.                         next if( $link->scheme ne 'http' && $link->scheme ne 'https' );
    
87.                         # another domain?
    
88.                         next if( $link->host ne $host );
    
89. 
    
90.                         $link = $link->abs->as_string;
    
91. 
    
92.                         if( $link =~ /(.*?)\#(.*)/ )
    
93.                         {
    
94.                                 $link = $1;
    
95.                         }
    
96. 
    
97.                         next if( $link =~ /\.(jpg|png|zip|rar|iso)$/i );
    
98. 
    
99.                         if( ! $filter->check($link) )
    
100.                         {
     
101.                                 print $filter->key_count(), " ", $link, "\n";
     
102.                                 $filter->add($link);
     
103.                                 $queue->enqueue($link);
     
104.                         }
     
105.                 }
     
106.         }
     
107.         $semaphore->up( );
     
108. }
     
109. 
     

复制代码

[ 本帖最后由 撒哈拉里的鱼 于 2009-12-27 19:59 编辑 ]

yz86yz

学习学习

撒哈拉里的鱼

原帖由 yz86yz 于 2009-12-27 20:00 发表
学习学习

你试试看能找出几个bug，这是最好的研究方式。
我随手之作，问题肯定不少的。

xp5211314

爬来的东西 还没存哦 呵呵

不过还是不错 支持楼主

[ 本帖最后由 xp5211314 于 2009-12-27 23:56 编辑 ]

yangds_cu

“Undefined subroutine &main::shared_clone called at spider.pl line 20.”
貌似没有找到这个方法？

撒哈拉里的鱼

是不是你的threads::shared版本太低了？你在cpan下面install一下试试。
我今天上午有空的话在检查一下代码，改改bug。

ttcn_cu

为何 同时有threads,Thread,不能只用一种么?

撒哈拉里的鱼

Thread::Queue和Thread::Semaphore只是个名字问题，模块作者使用了比较早的名字Thread，后来perl把线程改名为threads了。我上午稍微改了一下，代码如下：

1. 
   
2. #!/usr/bin/perl
   
3. use strict;
   
4. use warnings;
   
5. #use Data::Dumper;
   
6. use threads;
   
7. use threads::shared;
   
8. use Thread::Queue;
   
9. use Thread::Semaphore;
   
10. 
    
11. use Bloom::Filter;
    
12. use URI::URL;
    
13. use Web::Scraper;
    
14. 
    
15. my $max_threads = 20;
    
16. my $base_url = $ARGV[0] || 'http://www.icylife.net/icy/';
    
17. my $host = URI::URL->new($base_url)->host;
    
18. 
    
19. my $queue = Thread::Queue->new( );
    
20. my $semaphore = Thread::Semaphore->new( $max_threads );
    
21. my $filter = shared_clone( Bloom::Filter->new(capacity => 50000, error_rate => 0.001) );
    
22. 
    
23. $queue->enqueue( $base_url );
    
24. $filter->add( $base_url );
    
25. 
    
26. while( 1 )
    
27. {
    
28.         # join all threads which can be joined
    
29.         #my $joined = 0;
    
30.         foreach ( threads->list(threads::joinable) )
    
31.         {
    
32.                 #$joined ++;
    
33.                 $_->join( );
    
34.         }
    
35.         #print $joined, " joined\n";
    
36. 
    
37.         # if there are no url need process.
    
38.         my $item = $queue->pending();
    
39.         if( $item == 0 )
    
40.         {
    
41.                 my $active = threads->list(threads::running);
    
42.                 # there are no active thread, we finish the job
    
43.                 if( $active == 0 )
    
44.                 {
    
45.                         print "All done!\n";
    
46.                         last;
    
47.                 }
    
48.                 # we will get some more url if there are some active threads, just wait for them
    
49.                 else
    
50.                 {
    
51.                         #print "[MAIN] 0 URL, but $active active thread\n";
    
52.                         sleep 1;
    
53.                         next;
    
54.                 }
    
55.         }
    
56.        
    
57.         # if there are some url need process
    
58.         #print "[MAIN] $item URL\n";
    
59.         $semaphore->down;
    
60.         #print "[MAIN]Create thread.\n";
    
61.         threads->create( \&ProcessUrl );
    
62. }
    
63. 
    
64. # join all threads which can be joined
    
65. foreach ( threads->list() )
    
66. {
    
67.         $_->join( );
    
68. }
    
69. 
    
70. sub ProcessUrl
    
71. {
    
72.         my $scraper = scraper
    
73.         {
    
74.                 process '//a', 'links[]' => '@href';
    
75.         };
    
76. 
    
77.         my $res;
    
78.         my $link;
    
79. 
    
80.         while( my $url = $queue->dequeue_nb() )
    
81.         {
    
82.                 eval
    
83.                 {
    
84.                         $res = $scraper->scrape( URI->new($url) )->{'links'};
    
85.                 };
    
86.                 if( $@ )
    
87.                 {
    
88.                         warn "$@\n";
    
89.                         next;
    
90.                 }
    
91.                 next if (! defined $res );
    
92. 
    
93.                 #print "there are ".scalar(threads->list(threads::running))." threads, ", $queue->pending(), " urls need process.\n";
    
94. 
    
95.                 foreach( @{$res} )
    
96.                 {
    
97.                         $link = $_->as_string;
    
98.                         $link = URI::URL->new($link, $url);
    
99. 
    
100.                         # not http and not https?
     
101.                         next if( $link->scheme ne 'http' && $link->scheme ne 'https' );
     
102.                         # another domain?
     
103.                         next if( $link->host ne $host );
     
104. 
     
105.                         $link = $link->abs->as_string;
     
106.                         #next if( $link !~ /^http:\/\/www\.icylife\.net\/yunshu\//i );
     
107. 
     
108.                         if( $link =~ /(.*?)\#(.*)/ )
     
109.                         {
     
110.                                 $link = $1;
     
111.                         }
     
112. 
     
113.                         next if( $link =~ /\.(jpg|png|bmp|mp3|wma|wmv|gz|zip|rar|iso)$/i );
     
114. 
     
115.                         if( ! $filter->check($link) )
     
116.                         {
     
117.                                 print $filter->key_count(), " ", $link, "\n";
     
118.                                 $filter->add($link);
     
119.                                 $queue->enqueue($link);
     
120.                         }
     
121.                 }
     
122.         }
     
123.         $semaphore->up( );
     
124. }
     
125. 
     

复制代码

撒哈拉里的鱼

还是有一些小问题，等元旦有空了再改。

兰花仙子

我实际没有用过perl线程，主要是之前的工作环境，用mod_perl的多，大家都避免用threads。
另外perl线程据说开销也不小，数据跟进程一样，是完全clone的，没有太多性能上的优势。
对这个比较熟的可以解释下。