swishspider
上传用户:qin5330
上传日期:2007-01-05
资源大小:114k
文件大小:2k
源码类别:

搜索引擎

开发平台:

Perl

  1. #!/local/sparc/bin/perl
  2. use LWP::UserAgent;
  3. use LWP::RobotUA;
  4. use HTTP::Request;
  5. use HTTP::Status;
  6. use HTML::LinkExtor;
  7. if (scalar(@ARGV) != 2) {
  8.     print STDERR "Usage: SwishSpider localpath urln";
  9.     exit(1);
  10. }
  11. my $ua = new LWP::UserAgent;
  12. $ua->agent( "SwishSpider" );
  13. $ua->from( "ron@ckm.ucsf.edu" );
  14. my $localpath = shift;
  15. my $url = shift;
  16. my $request = new HTTP::Request( "GET", $url );
  17. my $response = $ua->simple_request( $request );
  18. #
  19. # Write out important meta-data.  This includes the HTTP code.  Depending on the
  20. # code, we write out other data.  Redirects have the location printed, everything
  21. # else gets the content-type.
  22. #
  23. open( RESP, ">$localpath.response" ) || die( "Could not open response file $localpath.response" );
  24. print RESP $response->code() . "n";
  25. if( $response->code() == RC_OK ) {
  26.     print RESP $response->header( "content-type" ) . "n";
  27. } elsif( $response->is_redirect() ) {
  28.     print RESP $response->header( "location" ) . "n";
  29. }
  30. close( RESP );
  31. #
  32. # Write out the actual data assuming the retrieval was succesful.  Also, if
  33. # we have actual data and it's of type text/html, write out all the links it
  34. # refers to
  35. #
  36. if( $response->code() == RC_OK ) {
  37.     my $contents = $response->content();
  38.     open( CONTENTS, ">$localpath.contents" ) || die( "Could not open contents file $localpath.contentsn" );
  39.     print CONTENTS $contents;
  40.     close( CONTENTS );
  41.     if( $response->header("content-type") eq "text/html" ) {
  42. open( LINKS, ">$localpath.links" ) || die( "Could not open links file $localpath.linksn" );
  43. $p = HTML::LinkExtor->new( &linkcb, $url );
  44. $p->parse( $contents );
  45. close( LINKS );
  46.     }
  47. }
  48. sub linkcb {
  49.     my($tag, %links) = @_;
  50.     if (($tag eq "a") && ($links{"href"})) {
  51. my $link = $links{"href"};
  52. #
  53. # Remove fragments
  54. #
  55. $link =~ s/(.*)#.*/$1/;
  56. #
  57. # Remove ../  This is important because the abs() function
  58. # can leave these in and cause never ending loops.
  59. #
  60. $link =~ s/..///g;
  61. print LINKS "$linkn";
  62.     }
  63. }