perl的一个例子

近期本人闲来没事做了一个程序自动从一些BT网站上抓取数据并且自动发帖到我自己的论坛上，试用了几个月效果比较好，现在公布源代码供perl爱好者参考，我的qq是2637663欢迎广大perl爱好者一起沟通交流。
分几个程序组成
readcokie.pl 获取要上传主机的cookie一次获取永久在主机保存
fatie.pl 抓取源主机数据并自动发帖到目标主机
history.log 保存抓取过的数据
user.txt 发帖时使用的用户列表
..........

具体程序如下
readcokie.pl
======================
# -*- coding: gb2312 -*-
#$ua->post( $url, /%form )
#$ua->post( $url, /@form )
#$ua->post( $url, /%form, $field_name => $value, ... )
#This method will dispatch a POST request on the given $url, with %form or @form providing the key/value pairs for the fill-in form content. Additional headers and content options are the same as for the get() method.
#This method will use the POST() function from HTTP::Request::Common to build the request. See the HTTP::Request::Common manpage for a details on how to pass form content and other advanced features.
#$ua->get( $url )
#$ua->get( $url , $field_name => $value, ... )
#This method will dispatch a GET request on the given $url. Further arguments can be given to initialize the headers of the request. These are given as separate name/value pairs. The return value is a response object. See the HTTP::Response manpage for a description of the interface it provides.
#$ua->agent('Mozilla/5.0');
use HTTP::Cookies;
use HTTP::Request::Common qw(POST);
use LWP::UserAgent;
$ua = LWP::UserAgent->new;
open(FILE,'D:/bin/posttools/自动发帖/bt区顶贴/cc8.cnsuk.net新沙加神话/data/user.txt');
@file=<FILE>;
for ($i=0;$i<=$#file;$i++){
chomp($file[$i]);
($user,$pass)=split(/,/,$file[$i]);
$ua->cookie_jar(HTTP::Cookies->new(file => "D://bin//posttools//自动发帖//bt区顶贴//cc8.cnsuk.net新沙加神话//data//$user//cookie.txt",
autosave => 1));
$req =POST 'http://www1.5hxy.com/bbs/login.asp',
[UserName => $user,
Userpass => $pass,
IsSave => '1',
Eremite => '1',
];
$res=$ua->request($req);
$ua->cookie_jar->save;
# $ua = LWP::UserAgent->close;
}




fatie.pl
=============================

use HTTP::Cookies;
use LWP;
$ua = LWP::UserAgent->new;
$ua->agent("Mozilla/8.0";
#初始化参数
$n_file='D:/bin/posttools/自动发帖/bt区顶贴/cc8.cnsuk.net新沙加神话//';

###临时种子文件地址
#定义地址@url @postid @bankuainame
$hhttp='http://cc8.cnsuk.net';
$url[0]='http://cc9.cnsuk.net/forum-2944-2.html';
$postid[0]='13';
$bankuainame[0]="$hhttp-游戏";

$url[1]='http://cc9.cnsuk.net/forum-2944-1.html';
$postid[1]='13';
$bankuainame[1]="$hhttp-游戏";

$url[2]='http://cc9.cnsuk.net/forum-2905-2.html';
$postid[2]='13';
$bankuainame[2]="$hhttp-游戏";

$url[3]='http://cc9.cnsuk.net/forum-2905-1.html';
$postid[3]='13';
$bankuainame[3]="$hhttp-游戏";
while (1) {
for ($u=0;$u<=$#url;$u++){
$htms='';
$res = $ua->get($url[$u]);
$htms=$res->content;
print "获取 $bankuainame[$u] 版块数据 /n";
#获取后挑出有用的数据
if ($res->is_success) {
@html=();
@html=split(//n/,$htms);
@link=();
@tid=();
@tti=();
for(@html){
#<a href="thread-50813-1-1.html" style="font-weight: bold;color: green">[04.19][BT游戏最新补丁发布专用贴][暂放]</a><span class="lighttxt">

#if (m{^<a href="(viewthread/.php/?tid=)(/d+)&.*>(.*)</a>}){
if (m{^<a href="(thread/-)(/d*)(/-/d*/-/d*/.html)".*?>(.*?)</a>}){
push(@link,$1.$2.$3);
push(@tid,$2);
push(@tti,$4);
}
}
}
print "挑出有用的数据 $#link 个 /n";
#历史记录
open (FILE,$n_file.'data/history.log');
@history=();
@history=<FILE>;
close FILE;
#用户记录
open(FILE,$n_file.'data/user.txt');
@usertxt=();
@usertxt=<FILE>;
close FILE;
#提交记录
print "读取用户信息 /n";
#检查帖子是否在历史,不在就发帖
$chazhao=0;#是否找到0没找到
for ($x=0;$x<=$#tid;$x++){
for ($a=0;$a<=$#history;$a++){
if ($history[$a]==$tid[$x]){
$a=$#history+1;
$chazhao=1;
}
}
print "帖子$tti[$x] $tid[$x] 找到标志为 $chazhao/n";
if ($chazhao==0){ #如果历史没有就发帖
#获取源帖子内容
$url="$hhttp/$link[$x]";
$res = $ua->get($url);
$htmls=$res->content;
#open (FILE,'>D:/bin/posttools/自动发帖/bt区顶贴/bbs.btpig.com猪猪乐园/bin/temp.log'); #debug
#print FILE $htmls; #debug
#close FILE; #debug
@html=();
@html=split(//n/,$htmls);
@torlink=();
@tortid=();
@torxylink=();
@tortti=();
$zd=0;
#获取所有种子地址
for(@html){
#<a href="viewthread.php?tid=645515&extra=page%3D1" style="font-weight: bold;color: blue">[02.02][原创][美国][二战][二战电影五部][DVDRip][6.1G] 英文字幕</a>
#<a href="attachment.php?aid=26721" target="_blank" class="bold">金庸群侠传全集★cc8cnsuk.net新沙加神话★VItas★.torrent</a> (2007-4-28 21:12, 17.35 K)<br>

if (m{<a href="(attachment/.php/?aid=)(/d+)".+?>(.+/.torrent)</a>}){
push(@torlink,$1.$2);
push(@tortid,$2);
push(@tortti,$3);
$zd=1;
}
}
#找到种子文件才发帖，否则不发帖
if ($zd==1){
$userc=int(rand($#usertxt));#选择哪个用户
chomp($usertxt[$userc]);
($user,$pass)=split(/,/,$usertxt[$userc]);
print "决定用户$userc发帖子/n";
#获取种子
@torxylink=();

for ($f=0;$f<=$#tortid;$f++){
$err=0;
$url="$hhttp/$torlink[$f]";
$res = $ua->get($url,referer=>$hhttp,);
print "种子获取成功,开始上传种子/n";
if ($res->is_success) {
$torrent=$res->content;
$filename="$n_file"."torrent//temp/.torrent";
open (FILE2,">$filename";
binmode(FILE2);
print FILE2 $torrent;
close FILE2;
#上传种子
w1:{$ua->cookie_jar(HTTP::Cookies->new(file => "$n_file"."data//$user//cookie/.txt",
autosave => 0));
$ua->timeout(240);
$response = $ua->post('http://www3.5hxy.com/bbs/UploadAttachment.asp',
Content_Type => 'form-data',
Content => [ file => ["$filename"],
],
referer=>'http://www3.5hxy.com/bbs/',);
#获取上传目标种子地址
#<a target=_blank href=UpFile/UpAttachment/2007-2/20072731345.torrent>http://www.5hxy.com/UpFile/UpAtt ... 20072731345.torrent</a>
if ($response->content=~m{(<a target=_blank href=.*?/.torrent.*?>}m){
push(@torxylink,$1.$tortti[$f].'</a>');
}else{
if ($err<=5){#如果没有错误5次继续尝试上传
$err++;
goto w1;
}
}
last w1;
}
}
print "种子上传完毕/n";
#sleep 3;
}
#拆分源帖子
$zzdaot=0;
$zzdaow=0;
for ($s=0;$s<=$#html;$s++){
#找帖子头部
if ($zzdaot==0){
if ($html[$s]=~m/<table width="95%" border="0" cellspacing="0" cellpadding="0"/){
$tou=$s+39; #+5是头部偏移量
$zzdaot=1;
}
}elsif ($zzdaow==0){
if ($html[$s]=~m/<table width="95%" border="0" cellspacing="0" cellpadding="0"/){
$wei=$s-30; #尾部偏移量
$zzdaow=1;
}
}
}
#如果只找到头没有找到尾那么尾偏移30；
if ($zzdaot==1 and $zzdaow=0){
$wei=$tou+30;
}
#获取所有图片地址
print "获取所有图片地址/n";
@imgh=();
for($b=$tou;$b<=$wei;$b++){
@imgh=split(/ /,$html[$b]);
for($j=0;$j<=$#imgh;$j++){
#<img src="http://img.album.pchome.net/02/71/78/71/efe60b699dcfb8277e0eb309ce4ee1ce.jpg" border="0" onload="if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.alt='Click here to open new window/nCTRL+Mouse wheel to zoom in/out';}" onmouseover="if(this.width>screen.width*0.7) {this.resized=true; this.width=screen.width*0.7; this.style.cursor='hand'; this.alt='Click here to open new window/nCTRL+Mouse wheel to zoom in/out';}" onclick="if(!this.resized) {return true;} else {window.open('http://img.album.pchome.net/02/71/78/71/efe60b699dcfb8277e0eb309ce4ee1ce.jpg');}" onmousewheel="return imgzoom(this);">
if ($imgh[$j]=~m{src="(.+/.jpg)"}){
$imgf=$1;
if ($imgf=~m/http/){
push(@img,"/[img/]$imgf/[/img/]";
}else{
push(@img,"/[img/]$hhttp/$imgf/[/img/]";
}
}
}
}
print "合并数据准备发帖/n";
$constor='';
#合并种子地址
for ($b=0;$b<=$#torxylink;$b++){
$constor.="<br><br> 本站种子地址torxylink[$b] <br><br>";
}
@torxylink=();
#合并图片地址
for ($b=0;$b<=$#img;$b++){
$constor.="<br><br> $img[$b] <br><br>";
}
@img=();
#合并要发送的数据
$cons=$constor;
for ($g=$tou;$g<=$wei;$g++){
$cons.=$html[$g];
}
$cons=~s/<i.*?//>//mg;
$cons=~s/<d.*?>//mg;
$cons=~s/<//d.*?>//mg;
$cons.="<br><br>此数据来自$hhttp/$link[$x] <br><br>";
#####开始发帖子哎，写了这么多终于可以发帖子了，真不容易
$ua->cookie_jar(HTTP::Cookies->new(file => "$n_file"."data//$user//cookie/.txt",
autosave => 0));
$ua->timeout(240);
$url='http://www3.5hxy.com/bbs/AddTopic.asp?ForumID='.$postid[$u];
#开始发帖子
print "开始发帖/n";
$response = $ua->post( $url,
[ForumID => $postid[$u],
Subject => $tti[$x] ,
Body => $cons,
UpFileId=>1,
#content => $cons,
#DisableYBBCode => '0'
],
referer=>'http://www3.5hxy.com/bbs/', );


}
print "帖子 $tti[$x]$tid[$x] 记录历史完毕 /n";
open (FILE,">>$n_file".'data/history.log'); #回过帖子的记录起来
print FILE "$tid[$x]/n";
close FILE;
}
print "==================== $bankuainame[$u] =======================/n";
$chazhao=0;
}
}
print "休眠1200秒 /n";
sleep 1200;
}