Perl爬虫代码

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

#!/usr/bin/perl -w

use strict; 
 
use HTTP::Request; 
use HTTP::Status; 
use HTML::LinkExtor; 
use URI::URL; 
use LWP::UserAgent; 
#use Digest::MD5  qw(md5_hex); 
 
 
use Compress::Zlib; 
 
#################################################################### 
# Parameters Setting 
our $StartUrl = "http://xxx"; 
our $bRestrict = 1; 
our @restrictSite = ('cxxx','context:'); 
our $bContinueBefore = 1; 
 
 
#################################################################### 
 
 
print __FILE__,"\n"; 
 
our %img_seen = (); 
our %url_seen = (); 
our @url_queue = (); 
our %url_processed = (); 
 
our %RobotDisallow = (); 
our %RobotAllow = (); 
our %site_seen = (); 
 
 
if($bContinueBefore){ 
    &LoadBefore(); 
}else{ 
    $url_seen{$StartUrl} = 1; 
    push @url_queue, $StartUrl; 
} 
 
our $pageNum = 0; 
our $BucketNum = 0; 
 
&OpenOutFile(); 
 
open(URLHASH,">>urlhash.txt") or die; 
open(URLPROCESSED,">>urlprocessed.txt") or die; 
open(URLREDIRECT,">>urlredirect.txt") or die; 
open(PAGELIST,">>pagelist.txt") or die; 
open(IMGLIST,">>imglist.txt") or die; 
 
 
$| = 1, select $_ for select URLHASH; 
$| = 1, select $_ for select URLPROCESSED; 
$| = 1, select $_ for select URLREDIRECT; 
$| = 1, select $_ for select PAGELIST; 
$| = 1, select $_ for select IMGLIST; 
 
our $urlhash_log = *URLHASH; 
our $urlprocessed_log = *URLPROCESSED; 
our $urlredirect_log = *URLREDIRECT; 
our $pagelist_log = *PAGELIST; 
our $imglist_log = *IMGLIST; 
 
 
our $UA =  new LWP::UserAgent(keep_alive =>  1, 
                              timeout    =>  60, 
                              ); 
$UA->agent('Mozilla/5.0'); 
$UA->proxy(['ftp', 'http', 'wais', 'gopher'],'http://jpproxy:80/'); 
 
our $linkExtor = new HTML::LinkExtor(\&linkCallback); 
our @tmpLinks = (); 
our @tmpImgs = (); 
 
my $url; 
while ( $url = &next_url() ) 
{ 
    print $urlprocessed_log $url,"\n"; 
     
    #sleep(1000); 
     
    my $response = &get_url( $url ); 
     
    if(!defined $response){ 
        next; 
    } 
     
    my $base = $response->base; 
    $base = $base->as_string; 
    #$base =~ tr/A-Z/a-z/; 
     
    if ( $base ne $url ) 
    { 
        if(!&ValidUrl($base)){ 
            next; 
        } 
         
        print $urlredirect_log $url,"\t",$base,"\n"; 
         
        $url_seen{$base} ++; 
        print $urlhash_log $base,"\n"; 
         
        if(exists($url_processed{$base})){ 
               next; 
        } 
    } 
     
    my $contents = $response->content; 
 
    #my $digest = md5_hex($base);     
     
    &SavePage(\$base,\$contents); 
    print $pagelist_log $base,"\n"; 
    $url_processed{$base} ++; 
         
     
    @tmpLinks = (); 
    @tmpImgs = (); 
    $linkExtor->parse($contents); 
     
    foreach (@tmpLinks){ 
        $_ = URI::URL->new($_,$base)->abs->as_string; 
        #$_ =~ tr/A-Z/a-z/; 
    } 
     
    foreach (@tmpImgs){ 
        $_ = URI::URL->new($_,$base)->abs->as_string; 
        #$_ =~ tr/A-Z/a-z/; 
    } 
     
    #@tmpLinks = map {$_ = URI::URL->new($_,$base)->abs->as_string;} @tmpLinks; 
    #@tmpImgs = map {$_ = URI::URL->new($_,$base)->abs->as_string;} @tmpImgs; 
     
    &RecordLinks(); 
    &RecordImgs(); 
     
} 
 
 
 
sub next_url 
{ 
 
    # We return 'undef' to signify no URLs on the list 
    if (@url_queue == 0 ) 
    { 
        return undef; 
    } 
     
    return shift @url_queue; 
} 
 
sub get_url 
{ 
    my $url   = shift; 
 
    my $request = new HTTP::Request( 'HEAD', $url ); 
    return undef unless $request; 
 
    my $response = $UA->request( $request ); 
    return undef unless defined $response; 
    return undef unless $response->is_success; 
 
    my $content_type = $response->content_type(); 
    return undef unless defined $content_type; 
 
    return undef if 'text/html' ne $content_type; 
     
    $request = new HTTP::Request( 'GET', $url ); 
    return undef unless $request; 
 
    $response = $UA->request( $request ); 
    return undef unless defined $response; 
    return undef unless $response->is_success; 
      
    return $response; 
} 
 
sub linkCallback 
{ 
    my($tag, %attr) = @_; 
    if($tag eq 'a' || $tag eq 'frame' || $tag eq 'area'){ 
        push(@tmpLinks,values %attr); 
        return; 
    } 
    if($tag eq 'img'){ 
        push(@tmpImgs,values %attr); 
        return; 
    } 
    return; 
} 
 
sub RecordLinks 
{ 
    foreach (@tmpLinks){ 
        if(/\/.+\.(\w{1,4})$/){ 
            if($1 =~ /(html|htm|asp|php|jsp)/i){ 
 
            }elsif($1 =~ /(jpg|jpeg|bmp|png|gif)/i){ 
                if(/^http/i){ 
                     
                    if(exists($img_seen{$_})){ 
                        next; 
                    } 
                     
                    $img_seen{$_} = 1; 
                    print $imglist_log $_,"\n"; 
                     
                } 
                next; 
 
            }else{ 
                next; 
            } 
        } 
             
        #if(/\.(gif|jpg|jpeg|png|xbm|au|wav|mpg|pdf|ps|mp3|mp2|rm|zip|rar|gz|zip)$/i){ 
        #    next;             
        #} 
 
        if(/^http/i){ 
             
            if(!&ValidUrl($_)){ 
                next; 
            } 
             
            s/#.*//;             
             
            if(exists($url_seen{$_})){ 
                next; 
            } 
             
            $url_seen{$_} = 1; 
            push @url_queue,$_; 
            print $urlhash_log $_,"\n"; 
        } 
    } 
} 
 
sub RecordImgs 
{ 
    foreach (@tmpImgs){ 
        if(/^http/i){ 
            if(!&ValidImage($_)){ 
                next; 
            } 
             
            if(exists($img_seen{$_})){ 
                next; 
            } 
             
            $img_seen{$_} = 1; 
            print $imglist_log $_,"\n"; 
     
        } 
    } 
} 
 
 
sub LoadBefore 
{ 
    open(FILE, "urlprocessed.txt") or die; 
    while(<FILE>){ 
        chomp; 
        $url_processed{$_}++; 
    } 
     
    open(FILE, "pagelist.txt") or die; 
    while(<FILE>){ 
        if(/(\S+)\s/){ 
            $url_processed{$1}++; 
        } 
    } 
 
    open(FILE, "urlhash.txt") or die; 
    while(<FILE>){ 
        chomp; 
        $url_seen{$_}++; 
        if(!exists($url_processed{$_})){ 
            push @url_queue,$_; 
        } 
    } 
 
    open(FILE, "imglist.txt") or die; 
    while(<FILE>){ 
        chomp; 
        $img_seen{$_}++; 
    } 
     
} 
 
 
sub ValidUrl 
{ 
    my($url) = shift; 
    if($bRestrict){ 
        foreach (@restrictSite){ 
            if($url =~ /$_/){ 
                return 1; 
            } 
        } 
        return 0; 
    }else{ 
        return 1; 
    } 
} 
 
sub ValidImage 
{ 
    my($url) = shift; 
    if($url =~ /#/){ 
        return 0; 
    } 
         
    if(/spacer\.gif/){ 
        return 0; 
    } 
 
    return 1; 
} 
 
 
sub get_robotstxt 
{ 
    my $url   = shift; 
    $url .= "/robots.txt"; 
     
    my $request = new HTTP::Request( 'HEAD', $url ); 
    return undef unless $request; 
     
    my $response = $UA->request( $request ); 
    return undef unless defined $response; 
    return undef unless $response->is_success; 
     
    my $content_type = $response->content_type(); 
    return undef unless defined $content_type; 
     
    return undef if 'text/plain' ne $content_type; 
     
    $request = new HTTP::Request( 'GET', $url ); 
    return undef unless $request; 
     
    $response = $UA->request( $request ); 
    return undef unless defined $response; 
    return undef unless $response->is_success; 
      
    return $response; 
} 
 
sub OpenOutFile 
{ 
    $BucketNum ++; 
    my $fname = sprintf("PageBucket.%05d",$BucketNum); 
    open(PAGEBUCKET,">>$fname") or die; 
    binmode(PAGEBUCKET); 
    $| = 1, select $_ for select PAGEBUCKET; 
} 
 
sub SavePage 
{ 
    my($urlR,$contR) = @_; 
    my $data = compress($$contR); 
    my $len = pack('I',length($$urlR)); 
    print PAGEBUCKET $len; 
    print PAGEBUCKET $$urlR; 
    $len = pack('I',length($data)); 
    print PAGEBUCKET $len; 
    print PAGEBUCKET $data; 
 
    $pageNum++;
    if($pageNum % 1000 == 0){ 
        print "$pageNum pages have been crawled!\n"; 
    } 
    if($pageNum % 100000 == 0){ 
        &OpenOutFile; 
    } 
}