微信公众号搜"智元新知"关注
微信扫一扫可直接关注哦！

用Perl脚本来抓去 天涯论坛 的帖子，呵呵 看帖子方便多了[网络爬虫]

分类：Perl作者：编程之家AI导航网

功能分析：

  给定一个 天涯论坛 的帖子URL链接地址，获取从当前地址开始的所有整个 主题帖子的内容。

  可以选定包含 非楼主回复内容

1， 先看看天涯论坛帖子中 我们所关心的文档结构：

<body>
 <div class="pagewrap">
   <h1><span>xxx</span>
       <span>标题</span></h1>
   <div class="function">
      <div class="info">点击数 回复数</div>
	  <!-- 或者没有下面的tag-->
	  <div class="pages" id="pageDivTop">
	   <form>
	         <input type="hidden" name="idArticleslist" value="所有的帖子地址ID">
	   </form>
	  </div>
   <!--楼主信息-->
   <table cellspacing="0" cellpadding="0" id="firstAuthor"><td><a>作者</a>发表日期</td></table>
   <div class="allpost" id="pContentDiv">
       <!--楼主贴-->
      <div class="post" _app="eleshare">
	  <!--回复人信息-->
	  <table bgcolor="#f5f9fa" width="100%"><font size="-1" color="green"><a>作者</a>发表日期</font></table>
	  <!--回复人帖子-->
	  <div class="post" _app="eleshare"></div>
 </div>
</body>

2，用HTML::TreeBuilder，LWP::Simple,HTML::Element,Encode库 来实现Reference :CPAN

3，一个文件crawl.pl，使用实例：

 Perl  crawl.pl http://www.tianya.cn/publicforum/content/funinfo/1/2854941.shtml  >ylbg.txt

 Perl  crawl.pl http://www.tianya.cn/publicforum/content/no05/1/204253.shtml > yslt.txt

4,crawl.pl文件源代码，呵呵，写的比较挫 还挺见谅啊 下载

【注意 引用处的 $$ 被CSDN替换为$了，CSDN编辑器太烂，都不支持Perl】

use strict;

use warnings;
use HTML::TreeBuilder;
use LWP::Simple;
use Encode;
no utf8; #pragma tells Perl to switch back to treating the source text as literal bytes in the current lexical scope.

#check to print the content of the others
# if 1,print the others,else 0,not to print
my $other=1;
$other=0 if (@ARGV > 1);

my ($url)=@ARGV; 
if (@ARGV <1)
{  
  print "Input an URL\n";  
  exit;
} 
  # http://www.baidu.com
if($url !~/^http:/)
{
  $url="http://$url";
}
  
my ($pagewrap,$title,$auther,#auther
	$clicks,#click number
	$totalPage,@idArticleslist,#all Articile ID list 
	$root  #HTML document root element
    );
&PrintPage($url);

sub InitRootfromURl()
{
  my ($url)=@_;
  my $content=get($url);
  #print "Get HTML document\n";
  die "Couldn't get the URL $url!" unless defined $content;
  $root = HTML::TreeBuilder->new_from_content($content);
  $root->eof( );  # done parsing for this tree
}

sub PrintPage()
{
#http://www.tianya.cn/publicforum/content/feeling/1/1323274.shtml
#urlPattern is :
#http://www.tianya.cn/publicforum/content/feeling/1
#posfitx is:
#shtml
  
    my ($link)=@_;
	my ( $urlPattern,#link pattern
	     $posfitx,#the link postfix
	     $CurrID #Input URL'ID
	    );
    my @tmp=split(/\//,$link);
    $urlPattern=join('/',@tmp[0..@tmp-2]);
    ($CurrID,$posfitx)=split(/\./,$tmp[@tmp-1]);
    @tmp=();
     
    &InitRootfromURl($link);
    &InitFromfirstLink(\$root);
	return unless ($idArticleslist[0]);
	if ($CurrID ne $idArticleslist[0])	
	{
	  $link="$urlPattern/$idArticleslist[0].$posfitx";
	  &InitRootfromURl($link);
      &InitFromfirstLink(\$root);
	  $root->delete(); #the first page will be deleted.
	}
    
	{#This infor below got from the first page.
	  print "title:";&toGBK(\$title) if ($title);
      print "\nauther:";&toGBK(\$auther) if ($auther);
      print "\nclicks:";&toGBK(\$clicks) if ($clicks);
      if ($totalPage){ print "\n";&toGBK(\$totalPage); print "\n";}
	}
	
	#Print the content infor of the all posts
	print "正文:\n";
	
	my ($i,$start)=(0,0);
    foreach my $id (@idArticleslist)
    { 
      $i++;
	  $start=1 if ( !$start && ($id eq $CurrID));
	  
	  if($start)
	  { 
	    print "\nPage $i\n";
	    $link="$urlPattern/$id.$posfitx";
	    &InitRootfromURl($link);
        &ParseAllPost(\$root);
		$root->delete();;# destroy the document
	  }
	}
}

sub toGBK()
{ 
  my ($content)=@_;
  $$content=~ s/牋牋/  /g;
  #print $$content;return 0; #If your OS is English,please comment it
  my @chars=split(//,$$content);
  foreach my $char (@chars) 
  {
     print encode("gbk",$char);
  } 
}
sub printContent()
{
  my ($content)=@_;
  $$content =~ s/\s+$//g;
  $$content =~ s/TML::Element=.+$//;
  &toGBK($content);
}
sub printReplier()
{
  my ($writer)=@_;
  return if ($$writer =~ /^\s*$/);
  $$writer =~ s/\s+//;
  my $dil="-" x length(Encode::encode_utf8($$writer));
  print  "\n$dil\n|";
  &toGBK($writer);
  print  "|\n$dil\n";
}

#=====
#print content info
sub ParsePost()
{
  my ($node)=@_;

  foreach my $n ($$node->content_list())
  {
     if ( $n =~ /^HTML::Element=/)
	 {
	   next if (! (my $tag=$n->tag()));
	   #print "$tag\n";
	   if ( $tag eq 'br'){print "\n"; next;}
	   next if ( ($tag eq 'div') && ($n->attr('class')) && ($n->attr('class') eq 'post-jb'));
	   next if ( $tag eq 'img');
	   next if ( $tag eq 'span');
	   next if ( $tag eq 'u');
	   &ParsePost(\$n);
	 }

	 {
	   &printContent(\$n);
	 }
  }
}
#Parse allpost
#=====
#print content info
sub ParseAllPost()
{
  my ($node)=@_; #allpost,HTML::Element
  my ($tag,$attr,@poster,$writer,$isShow);
  
  return unless ($$node);
  
  my @a=$$node->look_down(_tag=>'div',class=>'allpost',id=>'pContentDiv');
  return unless ($a[0]);
  $isShow=1;
  foreach my $n ($a[0]->content_list())
  {
    next if ( $n !~ /^HTML::Element=/);
	next if (! ($tag=$n->tag()));
	#parse the content of writer
	if ( $isShow && ($tag eq 'div'))
	{
	  next if (!($attr=$n->attr('class')));
	  next if ($attr ne 'post');
      &ParsePost(\$n);
	}
	#parse the writer
	if ( $tag eq 'table')
	{
	   @poster = $n->look_down(_tag=>'a',target=>'_blank');
	   $writer=$poster[0]->as_text();
	     
	   if (!$other)
	   {
	     if ($writer eq $auther){$isShow =1;}
         else {$isShow = 0;}	 
	   }
	   if ($isShow)
	   {
	      &printReplier(\$writer);
	   }
	}
  }
  #$$node->delete();#Delete all elements
}

#Initialize the auther info and link info
#Parse pagewrap and,find title,auther,and all links
sub InitFromfirstLink()
{
  my ($node)=@_;
  my ($tag,@tmp,@a,$b);

  #find the 'pagewrap' tag
  return unless ($$node);
  @tmp = $$node->look_down(_tag=>'div',class=>'pagewrap');
  
  return unless ($tmp[0]);
  foreach my $n ($tmp[0]->content_list())
  {
     next if ( $n !~ /^HTML::Element=/);
	 next if (! ($tag=$n->tag()));
	 if ( $tag eq 'h1')
	 {
	   @tmp = $n->look_down(_tag=>'span');
	   next unless ($tmp[1]);
	   $title=$tmp[1]->as_text();
	   @tmp=();
	   next;
	 }
	 if ( $tag eq 'table')
	 {
	    @tmp = $n->look_down(_tag=>'a');
		next unless ($tmp[0]);
	    $auther=$tmp[0]->as_text();
		@tmp=();
	    next;
	 }
	 next if (!($attr=$n->attr('class')));
	 if ( ($tag eq 'div') && ( $attr eq 'function'))
	 {
	    @tmp = $n->content_list();
		
		{
		  @a=();
		  @a=$n->look_down(_tag=>'span');
		  if ( @a > 0)
		  {$totalPage=$a[0]->as_text();}
		  @a=();
		}
		
		if ($tmp[0]->attr('class') eq 'info')
		{
		   @a=split(/ /,$tmp[0]->as_text());
		   $clicks=$a[1]; 
		   @a=();
		}else{ 
		 #print "error:",$tmp[0]->dump(); next;
		}
		
		{#get  idArticleslist
		 @a=();
		 @a=$n->look_down(_tag=>'input',name=>'idArticleslist');
		 if ( @a > 0){
		   $b=$a[0]->attr('value');
		   @idArticleslist=split(/,/,$b);
		}
		 @a=();
		}
    	 #print $tmp[1]->dump();
	    @tmp=();
		next;
	 }
	 if ( ($tag eq 'div') && ( $attr eq 'allpost'))
	 {
	 	 #$$node->detach;
		 last;
	 }
  }
}


=cut
天涯帖子结构
<body>
 <div class="pagewrap">
   <h1><span>xxx</span>
       <span>标题</span></h1>
   <div class="function">
      <div class="info">点击数 回复数</div>
	  <!-- 或者没有下面的tag-->
	  <div class="pages" id="pageDivTop">
	   <form>
	         <input type="hidden" name="idArticleslist" value="所有的帖子地址ID">
	   </form>
	  </div>
   <!--楼主信息-->
   <table cellspacing="0" cellpadding="0" id="firstAuthor"><td><a>作者</a>发表日期</td></table>
   <div class="allpost" id="pContentDiv">
       <!--楼主贴-->
      <div class="post" _app="eleshare">
	  <!--回复人信息-->
	  <table bgcolor="#f5f9fa" width="100%"><font size="-1" color="green"><a>作者</a>发表日期</font></table>
	  <!--回复人帖子-->
	  <div class="post" _app="eleshare"></div>
 </div>
</body>
=cut

版权声明：本文内容由互联网用户自发贡献，该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容， 请发送邮件至 dio@foxmail.com 举报，一经查实，本站将立刻删除。

相关推荐

Perl碎碎念
1. 如何去重 #!/usr/bin/perl use strict; my %hash; while(&lt;&gt;){ chomp; print &quot;$_n&quot; unless
如何用perl将表格中不同列的数据进行拼凑，然后将拼凑后的数据用“|”连接在一起
最近写了一个perl脚本，实现的功能是将表格中其中两列的数据进行拼凑，然后将拼凑后的数据用“|”连接在一起。表格内容如下： 员工号码员工姓名职位入职日期1001张三销售1980/12/17 0:00:
基于表的数据字典构造MySQL建表语句
表的数据字典格式如下：如果手动写MySQL建表语句，确认麻烦，还不能保证书写一定正确。写了个Perl脚本，可快速构造MySQL脚本语句。脚本如下：#!/usr/bin/perluse strict;m
如何用Perl对Excel的数据进行提取并分析
巡检类工作经常会出具日报，最近在原有日报的基础上又新增了一个表的数据量统计日报，主要是针对数据库中使用较频繁，数据量又较大的31张表。该日报有两个sheet组成，第一个sheet是数据填写，第二个sh
如何用Perl截取报文
在实际生产环境中，常常需要从后台日志中截取报文，报文的形式类似于.........一个后台日志有多个报文，每个报文可由操作流水唯一确定。以前用AWK写过一个，程序如下：beginline=`awk &
如何通过关键词匹配统计其出现的频率
最近写的一个perl程序，通过关键词匹配统计其出现的频率，让人领略到perl正则表达式的强大，程序如下：#!/usr/bin/perluse strict;my (%hash,%hash1,@arra
漫谈 Perl 的 web 应用开发框架
忍不住在 PerlChina 邮件列表中盘点了一下 Perl 里的 Web 应用框架（巧的是 PerlBuzz 最近也有一篇相关的讨论帖），于是乎，决定在我自己的 blog 上也贴一下 :) 原生 CGI/FastCGI 的 web app 对于较小的应用非常合适，但稍复杂一些就有些痛苦，但运行效率是最高的 ;) 如果是自己用 Perl 开发高性能的站，多推荐之。 Catalyst, CGI::A
perl中bless的理解
bless有两个参数：对象的引用、类的名称。 类的名称是一个字符串，代表了类的类型信息，这是理解bless的关键。 所谓bless就是把 类型信息 赋予 实例变量。 程序包括5个文件： person.pm ：实现了person类 dog.pm ：实现了dog类 bless.pl ： 正确的使用bless bless.wrong.pl ： 错误的使用bless bless.cc ： 使用C++语言实
PERL GB2312 UTF-8 编码转换
gb2312转Utf的方法： use Encode; my $str = "中文"; $str_cnsoftware = encode("utf-8", decode("gb2312", $str));   Utf转 gb2312的方法： use Encode; my $str = "utf8中文"; $str_cnsoftware = encode("gb2312", decode("utf-8
perl 计算硬盘利用率
  perl 计算硬盘利用率， 以%来查看硬盘资源是否存在IO消耗cpu资源情况； 部份代码参考了iostat源码；     #!/usr/bin/perl use Time::HiRes qw(gettimeofday); use POSIX; $SLEEPTIME=3; sub getDiskUtl() { $clock_ticks = POSIX::sysconf( &POSIX::_SC_
苹果市值2025年有望达4万亿美元
pythonJavaScriptjavaHTMLreactjsC#AndroidCSSNode.jssqlrpython-3.xMysqLjQueryc++pandasFlutterangularIOSdjangolinuxswifttypescript路由器JSON路由器设置无线路由器h3c华三华三路由器设置华三路由器电脑软件教程arraysdocker软件图文教程Cvue.jslaravelspring-bootreact-native