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;
}