免费注册 查看新帖 |

Chinaunix

  平台 论坛 博客 文库
123下一页
最近访问板块 发新帖
查看: 23260 | 回复: 20

下大雪不能出门,在家做了个简单的爬虫demo [复制链接]

论坛徽章:
0
发表于 2009-12-27 18:12 |显示全部楼层
主要是多线程、队列、Bloom Filter等的使用,没什么技术含量,算是个demo吧。爬行深度之类的我没加,加上也容易,几句话的事情。直接代码描述吧。我C写得多一些,所以perl代码的风格不怎么perl。

  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;

  4. use threads;
  5. use threads::shared;
  6. use Thread::Queue;
  7. use Thread::Semaphore;

  8. use Bloom::Filter;
  9. use URI::URL;
  10. use Web::Scraper;

  11. my $max_threads = 30;
  12. my $base_url = $ARGV[0] || 'http://www.icylife.net/';
  13. my $host = URI->new($base_url)->host;

  14. my $queue = Thread::Queue->new( );
  15. my $semaphore = Thread::Semaphore->new( $max_threads );
  16. my $filter = shared_clone( Bloom::Filter->new(capacity => 50000, error_rate => 0.001) );

  17. $queue->enqueue( $base_url );
  18. $filter->add( $base_url );

  19. while( 1 )
  20. {
  21.         # join all threads which can be joined
  22.         foreach ( threads->list(threads::joinable) )
  23.         {
  24.                 $_->join( );
  25.         }

  26.         # if there are no url need process.
  27.         my $item = $queue->pending();
  28.         if( $item == 0 )
  29.         {
  30.                 # there are no active thread, we finish the job
  31.                 if( threads->list(threads::running) == 0 )
  32.                 {
  33.                         print "All done!\n";
  34.                         last;
  35.                 }
  36.                 # we will get some more url if there are some active threads, just wait for them
  37.                 else
  38.                 {
  39.                         sleep 1;
  40.                         next;
  41.                 }
  42.         }
  43.        
  44.         # if there are some url need process
  45.         while( $semaphore->down )
  46.         {
  47.                 threads->create( \&ProcessUrl );
  48.         }
  49. }

  50. # join all threads which can be joined
  51. foreach ( threads->list() )
  52. {
  53.         $_->join( );
  54. }

  55. sub ProcessUrl
  56. {
  57.         my $scraper = scraper
  58.         {
  59.                 process '//a', 'links[]' => '@href';
  60.         };

  61.         my $res;
  62.         my $link;

  63.         while( my $url = $queue->dequeue_nb() )
  64.         {
  65.                 $res = $scraper->scrape( URI->new($url) )->{'links'};
  66.                 #print "there are ".scalar(threads->list(threads::running))." threads, ", $queue->pending(), " urls need process.\n";

  67.                 foreach( @{$res} )
  68.                 {
  69.                         $link = $_->as_string;
  70.                         $link = URI::URL->new($link, $url);

  71.                         # not http and not https?
  72.                         next if( $link->scheme ne 'http' && $link->scheme ne 'https' );
  73.                         # another domain?
  74.                         next if( $link->host ne $host );

  75.                         $link = $link->abs->as_string;

  76.                         if( $link =~ /(.*?)\#(.*)/ )
  77.                         {
  78.                                 $link = $1;
  79.                         }

  80.                         next if( $link =~ /\.(jpg|png|zip|rar|iso)$/i );

  81.                         if( ! $filter->check($link) )
  82.                         {
  83.                                 print $filter->key_count(), " ", $link, "\n";
  84.                                 $filter->add($link);
  85.                                 $queue->enqueue($link);
  86.                         }
  87.                 }
  88.         }
  89.         $semaphore->up( );
  90. }

复制代码

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

论坛徽章:
0
发表于 2009-12-27 20:00 |显示全部楼层
学习学习

论坛徽章:
0
发表于 2009-12-27 21:17 |显示全部楼层
原帖由 yz86yz 于 2009-12-27 20:00 发表
学习学习


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

论坛徽章:
0
发表于 2009-12-27 23:53 |显示全部楼层
爬来的东西 还没存哦 呵呵

不过还是不错 支持楼主

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

论坛徽章:
1
2015亚冠之塔什干火车头
日期:2015-07-13 12:36:28
发表于 2009-12-28 09:09 |显示全部楼层
“Undefined subroutine &main::shared_clone called at spider.pl line 20.”
貌似没有找到这个方法?

论坛徽章:
0
发表于 2009-12-28 09:25 |显示全部楼层
是不是你的threads::shared版本太低了?你在cpan下面install一下试试。
我今天上午有空的话在检查一下代码,改改bug。

论坛徽章:
1
狮子座
日期:2013-12-16 16:09:24
发表于 2009-12-28 15:56 |显示全部楼层
为何 同时有threads,Thread,不能只用一种么?

论坛徽章:
0
发表于 2009-12-28 16:54 |显示全部楼层
Thread::Queue和Thread::Semaphore只是个名字问题,模块作者使用了比较早的名字Thread,后来perl把线程改名为threads了。我上午稍微改了一下,代码如下:

  1. #!/usr/bin/perl
  2. use strict;
  3. use warnings;
  4. #use Data::Dumper;
  5. use threads;
  6. use threads::shared;
  7. use Thread::Queue;
  8. use Thread::Semaphore;

  9. use Bloom::Filter;
  10. use URI::URL;
  11. use Web::Scraper;

  12. my $max_threads = 20;
  13. my $base_url = $ARGV[0] || 'http://www.icylife.net/icy/';
  14. my $host = URI::URL->new($base_url)->host;

  15. my $queue = Thread::Queue->new( );
  16. my $semaphore = Thread::Semaphore->new( $max_threads );
  17. my $filter = shared_clone( Bloom::Filter->new(capacity => 50000, error_rate => 0.001) );

  18. $queue->enqueue( $base_url );
  19. $filter->add( $base_url );

  20. while( 1 )
  21. {
  22.         # join all threads which can be joined
  23.         #my $joined = 0;
  24.         foreach ( threads->list(threads::joinable) )
  25.         {
  26.                 #$joined ++;
  27.                 $_->join( );
  28.         }
  29.         #print $joined, " joined\n";

  30.         # if there are no url need process.
  31.         my $item = $queue->pending();
  32.         if( $item == 0 )
  33.         {
  34.                 my $active = threads->list(threads::running);
  35.                 # there are no active thread, we finish the job
  36.                 if( $active == 0 )
  37.                 {
  38.                         print "All done!\n";
  39.                         last;
  40.                 }
  41.                 # we will get some more url if there are some active threads, just wait for them
  42.                 else
  43.                 {
  44.                         #print "[MAIN] 0 URL, but $active active thread\n";
  45.                         sleep 1;
  46.                         next;
  47.                 }
  48.         }
  49.        
  50.         # if there are some url need process
  51.         #print "[MAIN] $item URL\n";
  52.         $semaphore->down;
  53.         #print "[MAIN]Create thread.\n";
  54.         threads->create( \&ProcessUrl );
  55. }

  56. # join all threads which can be joined
  57. foreach ( threads->list() )
  58. {
  59.         $_->join( );
  60. }

  61. sub ProcessUrl
  62. {
  63.         my $scraper = scraper
  64.         {
  65.                 process '//a', 'links[]' => '@href';
  66.         };

  67.         my $res;
  68.         my $link;

  69.         while( my $url = $queue->dequeue_nb() )
  70.         {
  71.                 eval
  72.                 {
  73.                         $res = $scraper->scrape( URI->new($url) )->{'links'};
  74.                 };
  75.                 if( $@ )
  76.                 {
  77.                         warn "$@\n";
  78.                         next;
  79.                 }
  80.                 next if (! defined $res );

  81.                 #print "there are ".scalar(threads->list(threads::running))." threads, ", $queue->pending(), " urls need process.\n";

  82.                 foreach( @{$res} )
  83.                 {
  84.                         $link = $_->as_string;
  85.                         $link = URI::URL->new($link, $url);

  86.                         # not http and not https?
  87.                         next if( $link->scheme ne 'http' && $link->scheme ne 'https' );
  88.                         # another domain?
  89.                         next if( $link->host ne $host );

  90.                         $link = $link->abs->as_string;
  91.                         #next if( $link !~ /^http:\/\/www\.icylife\.net\/yunshu\//i );

  92.                         if( $link =~ /(.*?)\#(.*)/ )
  93.                         {
  94.                                 $link = $1;
  95.                         }

  96.                         next if( $link =~ /\.(jpg|png|bmp|mp3|wma|wmv|gz|zip|rar|iso)$/i );

  97.                         if( ! $filter->check($link) )
  98.                         {
  99.                                 print $filter->key_count(), " ", $link, "\n";
  100.                                 $filter->add($link);
  101.                                 $queue->enqueue($link);
  102.                         }
  103.                 }
  104.         }
  105.         $semaphore->up( );
  106. }

复制代码

论坛徽章:
0
发表于 2009-12-28 16:56 |显示全部楼层
还是有一些小问题,等元旦有空了再改。

论坛徽章:
0
发表于 2009-12-28 20:13 |显示全部楼层
我实际没有用过perl线程,主要是之前的工作环境,用mod_perl的多,大家都避免用threads。
另外perl线程据说开销也不小,数据跟进程一样,是完全clone的,没有太多性能上的优势。
对这个比较熟的可以解释下。
您需要登录后才可以回帖 登录 | 注册

本版积分规则 发表回复

  

北京盛拓优讯信息技术有限公司. 版权所有 京ICP备16024965号-6 北京市公安局海淀分局网监中心备案编号:11010802020122 niuxiaotong@pcpop.com 17352615567
未成年举报专区
中国互联网协会会员  联系我们:huangweiwei@itpub.net
感谢所有关心和支持过ChinaUnix的朋友们 转载本站内容请注明原作者名及出处

清除 Cookies - ChinaUnix - Archiver - WAP - TOP