Perl爬虫代码

于 2019-09-07 21:00:49 发布
阅读量385 收藏 1
点赞数
文章标签： 爬虫 php
原文链接：https://my.oschina.net/xiaocon/blog/199319
版权

目前在做Perl页面爬虫的模块，发现一些代码，做个详细的分析，把好的引用一下给自己用用。

  1 #!/usr/bin/perl -w
  2 
  3 use strict; 
  4  
  5 use HTTP::Request; 
  6 use HTTP::Status; 
  7 use HTML::LinkExtor; 
  8 use URI::URL; 
  9 use LWP::UserAgent; 
 10 #use Digest::MD5  qw(md5_hex); 
 11  
 12  
 13 use Compress::Zlib; 
 14  
 15 #################################################################### 
 16 # Parameters Setting 
 17 our $StartUrl = "http://xxx"; 
 18 our $bRestrict = 1; 
 19 our @restrictSite = ('cxxx','context:'); 
 20 our $bContinueBefore = 1; 
 21  
 22  
 23 #################################################################### 
 24  
 25  
 26 print __FILE__,"\n"; 
 27  
 28 our %img_seen = (); 
 29 our %url_seen = (); 
 30 our @url_queue = (); 
 31 our %url_processed = (); 
 32  
 33 our %RobotDisallow = (); 
 34 our %RobotAllow = (); 
 35 our %site_seen = (); 
 36  
 37  
 38 if($bContinueBefore){ 
 39     &LoadBefore(); 
 40 }else{ 
 41     $url_seen{$StartUrl} = 1; 
 42     push @url_queue, $StartUrl; 
 43 } 
 44  
 45 our $pageNum = 0; 
 46 our $BucketNum = 0; 
 47  
 48 &OpenOutFile(); 
 49  
 50 open(URLHASH,">>urlhash.txt") or die; 
 51 open(URLPROCESSED,">>urlprocessed.txt") or die; 
 52 open(URLREDIRECT,">>urlredirect.txt") or die; 
 53 open(PAGELIST,">>pagelist.txt") or die; 
 54 open(IMGLIST,">>imglist.txt") or die; 
 55  
 56  
 57 $| = 1, select $_ for select URLHASH; 
 58 $| = 1, select $_ for select URLPROCESSED; 
 59 $| = 1, select $_ for select URLREDIRECT; 
 60 $| = 1, select $_ for select PAGELIST; 
 61 $| = 1, select $_ for select IMGLIST; 
 62  
 63 our $urlhash_log = *URLHASH; 
 64 our $urlprocessed_log = *URLPROCESSED; 
 65 our $urlredirect_log = *URLREDIRECT; 
 66 our $pagelist_log = *PAGELIST; 
 67 our $imglist_log = *IMGLIST; 
 68  
 69  
 70 our $UA =  new LWP::UserAgent(keep_alive =>  1, 
 71                               timeout    =>  60, 
 72                               ); 
 73 $UA->agent('Mozilla/5.0'); 
 74 $UA->proxy(['ftp', 'http', 'wais', 'gopher'],'http://jpproxy:80/'); 
 75  
 76 our $linkExtor = new HTML::LinkExtor(\&linkCallback); 
 77 our @tmpLinks = (); 
 78 our @tmpImgs = (); 
 79  
 80 my $url; 
 81 while ( $url = &next_url() ) 
 82 { 
 83     print $urlprocessed_log $url,"\n"; 
 84      
 85     #sleep(1000); 
 86      
 87     my $response = &get_url( $url ); 
 88      
 89     if(!defined $response){ 
 90         next; 
 91     } 
 92      
 93     my $base = $response->base; 
 94     $base = $base->as_string; 
 95     #$base =~ tr/A-Z/a-z/; 
 96      
 97     if ( $base ne $url ) 
 98     { 
 99         if(!&ValidUrl($base)){ 
100             next; 
101         } 
102          
103         print $urlredirect_log $url,"\t",$base,"\n"; 
104          
105         $url_seen{$base} ++; 
106         print $urlhash_log $base,"\n"; 
107          
108         if(exists($url_processed{$base})){ 
109                next; 
110         } 
111     } 
112      
113     my $contents = $response->content; 
114  
115     #my $digest = md5_hex($base);     
116      
117     &SavePage(\$base,\$contents); 
118     print $pagelist_log $base,"\n"; 
119     $url_processed{$base} ++; 
120          
121      
122     @tmpLinks = (); 
123     @tmpImgs = (); 
124     $linkExtor->parse($contents); 
125      
126     foreach (@tmpLinks){ 
127         $_ = URI::URL->new($_,$base)->abs->as_string; 
128         #$_ =~ tr/A-Z/a-z/; 
129     } 
130      
131     foreach (@tmpImgs){ 
132         $_ = URI::URL->new($_,$base)->abs->as_string; 
133         #$_ =~ tr/A-Z/a-z/; 
134     } 
135      
136     #@tmpLinks = map {$_ = URI::URL->new($_,$base)->abs->as_string;} @tmpLinks; 
137     #@tmpImgs = map {$_ = URI::URL->new($_,$base)->abs->as_string;} @tmpImgs; 
138      
139     &RecordLinks(); 
140     &RecordImgs(); 
141      
142 } 
143  
144  
145  
146 sub next_url 
147 { 
148  
149     # We return 'undef' to signify no URLs on the list 
150     if (@url_queue == 0 ) 
151     { 
152         return undef; 
153     } 
154      
155     return shift @url_queue; 
156 } 
157  
158 sub get_url 
159 { 
160     my $url   = shift; 
161  
162     my $request = new HTTP::Request( 'HEAD', $url ); 
163     return undef unless $request; 
164  
165     my $response = $UA->request( $request ); 
166     return undef unless defined $response; 
167     return undef unless $response->is_success; 
168  
169     my $content_type = $response->content_type(); 
170     return undef unless defined $content_type; 
171  
172     return undef if 'text/html' ne $content_type; 
173      
174     $request = new HTTP::Request( 'GET', $url ); 
175     return undef unless $request; 
176  
177     $response = $UA->request( $request ); 
178     return undef unless defined $response; 
179     return undef unless $response->is_success; 
180       
181     return $response; 
182 } 
183  
184 sub linkCallback 
185 { 
186     my($tag, %attr) = @_; 
187     if($tag eq 'a' || $tag eq 'frame' || $tag eq 'area'){ 
188         push(@tmpLinks,values %attr); 
189         return; 
190     } 
191     if($tag eq 'img'){ 
192         push(@tmpImgs,values %attr); 
193         return; 
194     } 
195     return; 
196 } 
197  
198 sub RecordLinks 
199 { 
200     foreach (@tmpLinks){ 
201         if(/\/.+\.(\w{1,4})$/){ 
202             if($1 =~ /(html|htm|asp|php|jsp)/i){ 
203  
204             }elsif($1 =~ /(jpg|jpeg|bmp|png|gif)/i){ 
205                 if(/^http/i){ 
206                      
207                     if(exists($img_seen{$_})){ 
208                         next; 
209                     } 
210                      
211                     $img_seen{$_} = 1; 
212                     print $imglist_log $_,"\n"; 
213                      
214                 } 
215                 next; 
216  
217             }else{ 
218                 next; 
219             } 
220         } 
221              
222         #if(/\.(gif|jpg|jpeg|png|xbm|au|wav|mpg|pdf|ps|mp3|mp2|rm|zip|rar|gz|zip)$/i){ 
223         #    next;             
224         #} 
225  
226         if(/^http/i){ 
227              
228             if(!&ValidUrl($_)){ 
229                 next; 
230             } 
231              
232             s/#.*//;             
233              
234             if(exists($url_seen{$_})){ 
235                 next; 
236             } 
237              
238             $url_seen{$_} = 1; 
239             push @url_queue,$_; 
240             print $urlhash_log $_,"\n"; 
241         } 
242     } 
243 } 
244  
245 sub RecordImgs 
246 { 
247     foreach (@tmpImgs){ 
248         if(/^http/i){ 
249             if(!&ValidImage($_)){ 
250                 next; 
251             } 
252              
253             if(exists($img_seen{$_})){ 
254                 next; 
255             } 
256              
257             $img_seen{$_} = 1; 
258             print $imglist_log $_,"\n"; 
259      
260         } 
261     } 
262 } 
263  
264  
265 sub LoadBefore 
266 { 
267     open(FILE, "urlprocessed.txt") or die; 
268     while(<FILE>){ 
269         chomp; 
270         $url_processed{$_}++; 
271     } 
272      
273     open(FILE, "pagelist.txt") or die; 
274     while(<FILE>){ 
275         if(/(\S+)\s/){ 
276             $url_processed{$1}++; 
277         } 
278     } 
279  
280     open(FILE, "urlhash.txt") or die; 
281     while(<FILE>){ 
282         chomp; 
283         $url_seen{$_}++; 
284         if(!exists($url_processed{$_})){ 
285             push @url_queue,$_; 
286         } 
287     } 
288  
289     open(FILE, "imglist.txt") or die; 
290     while(<FILE>){ 
291         chomp; 
292         $img_seen{$_}++; 
293     } 
294      
295 } 
296  
297  
298 sub ValidUrl 
299 { 
300     my($url) = shift; 
301     if($bRestrict){ 
302         foreach (@restrictSite){ 
303             if($url =~ /$_/){ 
304                 return 1; 
305             } 
306         } 
307         return 0; 
308     }else{ 
309         return 1; 
310     } 
311 } 
312  
313 sub ValidImage 
314 { 
315     my($url) = shift; 
316     if($url =~ /#/){ 
317         return 0; 
318     } 
319          
320     if(/spacer\.gif/){ 
321         return 0; 
322     } 
323  
324     return 1; 
325 } 
326  
327  
328 sub get_robotstxt 
329 { 
330     my $url   = shift; 
331     $url .= "/robots.txt"; 
332      
333     my $request = new HTTP::Request( 'HEAD', $url ); 
334     return undef unless $request; 
335      
336     my $response = $UA->request( $request ); 
337     return undef unless defined $response; 
338     return undef unless $response->is_success; 
339      
340     my $content_type = $response->content_type(); 
341     return undef unless defined $content_type; 
342      
343     return undef if 'text/plain' ne $content_type; 
344      
345     $request = new HTTP::Request( 'GET', $url ); 
346     return undef unless $request; 
347      
348     $response = $UA->request( $request ); 
349     return undef unless defined $response; 
350     return undef unless $response->is_success; 
351       
352     return $response; 
353 } 
354  
355 sub OpenOutFile 
356 { 
357     $BucketNum ++; 
358     my $fname = sprintf("PageBucket.%05d",$BucketNum); 
359     open(PAGEBUCKET,">>$fname") or die; 
360     binmode(PAGEBUCKET); 
361     $| = 1, select $_ for select PAGEBUCKET; 
362 } 
363  
364 sub SavePage 
365 { 
366     my($urlR,$contR) = @_; 
367     my $data = compress($$contR); 
368     my $len = pack('I',length($$urlR)); 
369     print PAGEBUCKET $len; 
370     print PAGEBUCKET $$urlR; 
371     $len = pack('I',length($data)); 
372     print PAGEBUCKET $len; 
373     print PAGEBUCKET $data; 
374  
375     $pageNum++;
376     if($pageNum % 1000 == 0){ 
377         print "$pageNum pages have been crawled!\n"; 
378     } 
379     if($pageNum % 100000 == 0){ 
380         &OpenOutFile; 
381     } 
382 }
点开查看代码

 

转载于:https://my.oschina.net/xiaocon/blog/199319

chiqu8683
关注
Perl爬虫的简单实现
qq_38791687的博客
01-09 395
由于工作中有个项目需要爬取第三方网站的内容，所以在Linux下使用Perl写了个简单的爬虫。 相关工具 1. HttpWatch/浏览器开发人员工具 一般情况下这个工具是用不到的，但是如果你发现要爬取的内容在页面的HTML源码里找不到，如有的页面是通过AJAX异步请求数据的，这时候就需要HttpWatch之类的工具来找到实际的HTTP请求的URL了，当然现在很多浏览器都有开发人员工具（如Ch...
Crawlperl：用Perl制作的网络爬虫。 非常适合在网上抓取或搜索数据，或者确保自己的站点文件是安全且隐藏的
02-05
Crawlperl：用Perl制作的网络爬虫。 非常适合在网上抓取或搜索数据，或者确保自己的站点文件是安全且隐藏的
Perl网络爬虫程序
09-26
用Perl脚本来抓去 天涯论坛 的帖子，呵呵 看帖子方便多了[网络爬虫]
Perl网页爬虫
weixin_30746117的博客
05-06 144
这代码还没来的急分析，这几天忙一些事情，先mark下官方的代码，等忙完这几天我就好好看看！ #!/usr/bin/perl use LWP::UserAgent; use HTML::LinkExtor; use URI::URL; $url = "http://www.163.com"; # for instance $ua = LWP::UserAgent->n...
perl爬虫
weixin_33904756的博客
03-17 107
爬行深度之类的我没加，加上也容易，几句话的事情。直接代码描述吧。我C写得多一些，所以perl代码的风格不怎么perl。   #d:\perl\bin\perl.exe -wuse warnings; use Data::Dumper;use threads;use threads::shared;use Thread::Queue;use Thread::Semaphore; use Bloo...
Perl爬虫动手(抓首页)
weixin_30345577的博客
06-02 109
下面的代码目前只实现了抓取首页，后面会改下，要求抓2级到3级页面。 #!/usr/bin/perl use HTML::LinkExtor; use LWP::Simple; sub sparit{ local($base_url)= shift; # 抓取URL $parser = HTML::LinkExtor->new(undef,$base...
perl_爬虫脚本
05-06
银行外汇牌价爬虫。结合中英两版网站信息，适合perl初学者学习模块和哈希数组等。文件为txt格式代码在其中。-Reptile Exchange Bank. Binding ounce version of the site information for beginners to learn perl ...
Perl爬虫教程：抓取天气信息
"Perl爬虫程序的简单教程" 在Perl编程语言中，创建网络爬虫是一种常见的任务，用于自动抓取网页数据。本教程通过一个简单的例子，介绍如何使用Perl和正则表达式来实现一个基础的网页爬虫，特别针对抓取天气预报信息...
Perl语言编程.pdf
03-10
* 安全性欠缺：Perl语言的安全性欠缺，需要用户小心地编写代码来避免安全问题。 Perl语言的发展历史： * 1987年，Larry Wall开发了Perl语言的第一个版本。 * 1991年，Perl语言的第二个版本发布，添加了许多新的...
Perl Web Scraping Project:Perl 网页抓取项目-开源
06-29
网络抓取（网络收集或网络数据提取）是用于从网站中提取数据的数据抓取。[1] 网络抓取软件可以直接使用超文本传输​​协议或通过网络浏览器访问万维网。 虽然网络抓取可以由软件用户手动完成，但该术语通常是指使用机器人或网络爬虫实现的自动化过程。 它是一种复制形式，其中从网络收集和复制特定数据，通常会复制到中央本地数据库或电子表格中，以供以后检索或分析。 网页抓取网页涉及获取它并从中提取。 [1] [2] 获取是下载页面（当您查看页面时浏览器会这样做）。 因此，网络爬虫是网络爬虫的主要组成部分，用于抓取页面以供后续处理。 一旦获取，则可以进行提取。 页面的内容可能会被解析、搜索、重新格式化、将其数据复制到电子表格中等等。
Perl爬虫--爬特定内容的网页
weixin_34365635的博客
05-22 156
前一篇博文是对当当网图书详情页面进行分析，提取图书的相关信息。 现在要解决的问题做一个爬虫把当当网图书详情页面下载下来。一般爬虫的基本思路是这样的：给定一个初始URL，沿着网页间的超链接链一直访问下去。但这里要注意几个问题： 避免回路出现死循环。使用队列来存储待访问的URL方法简单，网页访问顺序是固定死的；采用来存储待访问的URL，可以很好地用树的层次结构来表示网页的层次结构，对树的遍历可...
用perl分析html
cnki_ok的专栏
06-09 2161
注：本文参考Perl&LWP一书。http://sendtowu.blog.163.com/    我的博客地址本人英语水平有限，以下文字是基于我的理解写的，并非原文翻译（我也没那本事）。前些日子需要从网页上提取文字信息，我决定用perl做这件事情。在网上搜了半天发现用HTML::TreeBuilder是一个很好的选择。于是从网上又找到了Perl&LWP这本书。看了两天终于看明白了，也
使用Perl语言写个简单的爬虫
weixin_33937913的博客
05-05 171
之前用Scala和Go语言分别都写了一个爬虫，最近看了Perl，就来写个功能相同的版本。使用到了LWP::Simple模块，使用 cpan LWP安装即可（Ubuntu 13.04没有随Perl一同提供这个重要模块，太可惜了）。代码如下： 1 #!/usr/bin/perl 2 use LWP::Simple qw/get/; 3 4 my %pages; 5 print...
Perl单URL爬虫
weixin_30569001的博客
05-08 99
分析了下代码，之前官方那段其实很简单，只要理解了，就能随意改动了。 根据自己的想法，目前想做的是全方位爬虫，并不是类似如此简单的爬， 简单的整理了下这个单例的抓URL。效果一般般，这几天忙完事情，我就改成多线程。 把URL的深度选项加入，以及可定向操作级别。这东西是我一直在思考的东西，也是我的一个想法。 把单例的例子保存下，方便以后翻。 #!/usr/bin/perl use ...
Perl 未完工的爬虫
weixin_30394669的博客
09-29 71
根据实际的逻辑,综合了各家所长,我决定手工测试下,是否能够写出满意的爬虫. 对此还是写出来看看,一边写一边思考,今天写了一点,等回家继续想想. 根据逻辑思考,我觉得应该使用队列,和BS算法做基础,还要做链接索引. 其中最难的莫过于链接索引了,这个东西还是得思考下的.现在还没想好,等等再看吧. #!/usr/bin/perl use LWP::Simple; use HTML::Li...
用perl写的一个网络爬虫
witwolf的专栏
01-04 3740
#!/usr/bin/perl use warnings; use strict; no warnings "recursion"; use XML::Writer; use LWP::Simple; use Encode; local *FILE; select FILE; my($xml,@urls,$html,$filename); foreach('A'..'Z'){     my @visited;     $filename
评论
添加红包

请填写红包祝福语或标题

个

红包个数最小为10个

元

红包金额最低5元

当前余额3.43元 前往充值 >
需支付：10.00元
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付元
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明：

1.余额是钱包充值的虚拟货币，按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载，可以购买VIP、付费专栏及课程。

余额充值