home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 35 Internet / 35-Internet.zip / swish131.zip / swishspider.pl < prev    next >
Perl Script  |  1998-10-21  |  2KB  |  76 lines
  1. #!/usr/local/bin/perl5.005
  2.  
  3. use LWP::UserAgent;
  4. use LWP::RobotUA;
  5. use HTTP::Request;
  6. use HTTP::Status;
  7. use HTML::Parse;
  8.  
  9. if (scalar(@ARGV) != 2) {
  10.     print STDERR "Usage: SwishSpider localpath url\n";
  11.     exit(1);
  12. }
  13.  
  14. my $ua = new LWP::UserAgent;
  15. $ua->agent( "SwishSpider" );
  16. $ua->from( "ron\@ckm.ucsf.edu" );
  17.  
  18. my $localpath = shift;
  19. my $url = shift;
  20.  
  21. my $request = new HTTP::Request( "GET", $url );
  22. my $response = $ua->simple_request( $request );
  23.  
  24. #
  25. # Write out important meta-data.  This includes the HTTP code.  Depending on the
  26. # code, we write out other data.  Redirects have the location printed, everything
  27. # else gets the content-type.
  28. #
  29. open( RESP, ">$localpath.response" ) || die( "Could not open response file $localpath.response" );
  30. print RESP $response->code() . "\n";
  31. if( $response->code() == RC_OK ) {
  32.     print RESP $response->header( "content-type" ) . "\n";
  33. } elsif( $response->is_redirect() ) {
  34.     print RESP $response->header( "location" ) . "\n";
  35. }
  36. close( RESP );
  37.  
  38. #
  39. # Write out the actual data assuming the retrieval was succesful.  Also, if
  40. # we have actual data and it's of type text/html, write out all the links it
  41. # refers to
  42. #
  43. if( $response->code() == RC_OK ) {
  44.     my $contents = $response->content();
  45.  
  46.     open( CONTENTS, ">$localpath.contents" ) || die( "Could not open contents file $localpath.contents\n" );
  47.     print CONTENTS $contents;
  48.     close( CONTENTS );
  49.  
  50.     if( $response->header("content-type") eq "text/html" ) {
  51.     open( LINKS, ">$localpath.links" ) || die( "Could not open links file $localpath.links\n" );
  52.  
  53.     my $html = HTML::Parse::parse_html( $contents );
  54.     foreach ( @{$html->extract_links( qw(a) )} ) {
  55.         my $link = new URI::URL( $$_[0], $url )->abs();
  56.  
  57.         #
  58.         # Remove fragments
  59.         #
  60.         $link =~ s/(.*)#.*/$1/;
  61.  
  62.         #
  63.         # Remove ../  This is important because the abs() function
  64.         # can leave these in and cause never ending loops.
  65.         #
  66.         $link =~ s/\.\.\///g;
  67.  
  68.         print LINKS "$link\n";
  69.     }
  70.  
  71.     close( LINKS );
  72.     }
  73. }
  74.  
  75.  
  76.