All pastes #994063 Raw Edit

Mine

public text v1 · immutable
#994063 ·published 2008-04-23 02:25 UTC
rendered paste body
#!/usr/bin/perl
use strict;
use LWP::UserAgent;
use HTML::TokeParser::Simple;
use Data::Validate::Email qw(is_email is_email_rfc822);
use URI;
use threads;
my $gogo = 1;    

sub main {
 
 while ($gogo  == 1) {
  foreach my $url (readLinks(100000)) {
  chomp($url);
  print "browsing $url\n";
  my $thread = threads->new(\&wwget, $url);
  $thread->detach();
  print "browsed of $url completed\n";
  sleep 1;
  }
 }
}


sub wwget { 
my $url = $_[0];

my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my $response = $ua->get($url);
     if ($response->is_success) {    
     is_line($response->content);
     extractLinks($url, $response->content);
     }
     else {
     print $response->status_line;
     }
}

sub is_line {
my @ar = @_;  
my @ar2;
  foreach my $l (@ar) {
     my $p = HTML::TokeParser::Simple->new(\$l);
      while (my $token = $p->get_token) {
      next unless $token->is_text;
      my $line = $token->as_is;
      push (@ar2, $line);
      }
  }
 @ar2 = map { split ' ' } @ar2; 
  foreach my $l2 (@ar2) {
  checkemail($l2);
  }
}

sub extractLinks {
my ($url, $html) = @_;
my $p = HTML::TokeParser->new(\$html);

  while (my $token = $p->get_tag("a")) {
        my $link = URI->new_abs($token->[1]{href}, $url);
        #my $text = $p->get_trimmed_text("/a");
        next if $link =~ m/^javascript\:/;
                    
                    if ($link =~ m/^mailto\:/) {
                    $link =~ s/^mailto\://g;
                    checkemail($link);
                    next;
                    
                    }
          if (!is_added($link)) {
          saveLink($link);
          } else {
          # Link was already added;)
          }
  }
}

sub saveLink {
my $link = $_[0];
my $savefile = "urls/tocrawl.txt";

 open (FILE, ">>$savefile") or die ("Couldn't open $savefile: $!\n");
 print FILE $link . "\n";
 close(FILE);
}                                                                      

sub getSerial {
my ($sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst) = localtime time;
return $sec . $min . $hour . $mday . $mon . $year . $wday . $yday . $isdst;
}                                                                      

sub readLinks {
my $savefile = "urls/tocrawl.txt";
my $limit = $_[0];
my @array;

@array = readF($savefile, $limit); 
my $elements = scalar(@array);

 if ($elements == 0) {
 print "No urls were found, reading seeds.\n";
 @array = readF("urls/seeds.txt", $limit);
 }
return @array;
}


sub readF {
my @array;
my $i = 0;
my $limit = $_[1];
open (FILE, $_[0]) or die ("Couldn't open $_[0]: $!\n");

  while(<FILE>) {
  last if $limit == $i;
  $i++;
  push @array, $_;
  }
 close(FILE);

return @array;
}
 

sub checkemail {
my $suspect = $_[0];
   if(is_email($suspect)){
   save_to("emails/sure.txt", $suspect);
   } elsif(is_email_rfc822($suspect)){
   save_to("emails/unsure.txt", $suspect);
   } else {
   #print "$suspect :Not an email address\n";
   }
}

sub save_to {
my ($to, $email) = @_;

 if(!is_there($to, $email)) {
  print "Mail found: $email  :saving to: $to\n";
     
  open(FILE, ">>$to") or die("Couldn't open $to : $!\n");
  print FILE $email . "\n";
  close(FILE);
 }

}

sub is_added {
my $savelink = "urls/tocrawl.txt";
my $link = $_[0];

   open(FILE, $savelink) or die ("Couldn't open $savelink : $!\n");
   foreach my $line (<FILE>) {
   chomp($line);
    if ($line eq $link) {
    return 1;
    } 
   }
   close(FILE);
return 0;
}

sub is_there {
my ($to, $email) = @_;

   open(FILE, $to) or die("Couldn't open $to : $!\n");
     foreach my $line (<FILE>) {
       chomp($line);
       if ($line eq $email) {
       return 1;
       }
     }
   close(FILE);
return 0;

}



main();