grokker.pl

#!/usr/bin/perl -Tw
# email web grokker v1.0

use strict;
my $MAX_DEPTH = 3;
my $debug = undef;
my $urlfile = undef;
my $emailsfile = "emails.log";
my $nested = 0;
my @urls;
my %addy;
my %emails;
my %html;
my %links;

BEGIN {
    eval qq{
        use LWP::UserAgent;
        use HTTP::Request::Common qw(POST GET);
	use HTML::Tree;
	use HTML::Element;
	use Email::Valid;
	use URI;
    };
}

&initialize();			#### initialize variables and blah blah blah...
get_urls($urlfile);		#### load up list of the main urls from file

for (my $i=0; $i<=$#urls; $i++){
  my $url = $urls[$i];
  log_grokker("Processing url: $url") if defined $debug;
  $html{$url} = retr_html($url);		#### takes scalar of url as arg, returns ref to scalar of html
						#print ${$html{$url}} && exit if defined $debug;
  $emails{$url} = grok_emails($url);		#### takes scalar of url as arg, returns ref of array of email addresses
						#print ref $emails{$url} && exit if defined $debug;
  $links{$url} = grok_links($url);		#### takes scalar of url as arg, returns ref of array of urls, derefs $html{$url}
						#print ref $links{$url} && exit if defined $debug;
}

for my $key (keys %links){
  savelinks($key,@{$links{$key}});		#### fld++
}

&dump_emails();

sub dump_emails{
  my $emls = "";
  for (keys %addy){
    $emls .= $_."\n";
  }
  open (FH, ">>$emailsfile");
  print FH $emls;
  close (FH);
}

sub savelinks {
  #### fld++
  my $parent = shift;
  $nested++;
  for my $link (@_) {
    next if exists $links{$link};
    log_grokker("Processing url: $link") if defined $debug;
    $html{$link} = retr_html($link);
    next if !defined $html{$link};
    $links{$link} = grok_links($link);
    $emails{$link} = grok_emails($link);

    if($nested <= $MAX_DEPTH) {
      savelinks($link, @{$links{$link}});
    }    
  }
}

sub grok_emails {
  my $url = $_[0];
  my $return;
  while (${$html{$url}} =~ /([a-zA-Z][\w\.-]*[a-zA-Z0-9]@[a-zA-Z0-9][\w\.-]*[a-zA-Z0-9]\.[a-zA-Z][a-zA-Z\.]*[a-zA-Z])/gi){
    my $addy = $1;
    if (Email::Valid->address($addy)){
      push (@{$return},$addy);
      $addy{$addy}++;
    }
  }
  return $return;
}

sub grok_links {
  ##### takes scalar of url as arg, and returns ref to array of links
  ##### derefs $html{$url}
  my $url = $_[0];
  my $return = undef;
  my $tree = HTML::TreeBuilder->new;
  $tree->parse("${$html{$url}}");
  $tree->elementify();
  #log_grokker ("Extracting links in \"$url\"") if defined $debug;
  for (@{$tree->extract_links}){
    my $abs_link = absolutize (scalar ${$_}[0], $url);
    next if $abs_link =~ /^mailto\:.*/i;
    next if scalar ${$_}[0] =~ /(\.js|\.gif|\.jpg|\.jpeg|\.css)$/i;
    next if exists $links{$url};
    #log_grokker("Found link in parent $url:\"$abs_link\"") if defined $debug;
    push (@{$return}, $abs_link);
  }
  $tree->delete();
  return $return;
}

sub retr_html {
  #### takes scalar of url as arg, returns ref to scalar of html
  my $url = $_[0];
  my $return = undef;
  #log_grokker ("Retrieving html for \"$url\"") if defined $debug;
  my $Converter = "$url";
  my $ua = new LWP::UserAgent;
     $ua->agent('Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.1; SV1)');
     #$ua->agent("Mozilla/4.5 " . $ua->agent);
     $ua->timeout(10);
  my $req = GET $Converter;
  my $res = $ua->request($req);
  if ($res->is_success) {
    my $html = $res->as_string;
    if ($html !~ /href/i){
      log_grokker ("WARNING: no links found in doc: \"$url\"");
    } else {
    }
    $return = \$html;
  }
  return $return;
}

sub absolutize {
  my($url, $base) = @_;
  return URI->new_abs($url, $base)->canonical;
}

sub get_urls {
  open (FH,$urlfile);
  while(<FH>){;
    chomp;
    $_ = 'http://'.$_ if $_ !~ /^http/i;
    push (@urls, $_);
  }
  close(FH);
  my $total = $#urls+1;
  log_grokker ("loaded up $total urls from \"$urlfile\"");
}

sub usage {
  print "Usage:\n\t$0 <urlfile.txt>\n\n";
  exit;
}

sub initialize {
  usage() if !defined $ARGV[0];
  $urlfile = $ARGV[0];
  if (defined $ARGV[1] && $ARGV[1] =~ /debug/i){
    $debug = 1;
  }
}

sub get_date {
    my @days   = ('Sun','Mon','Tue','Wed','Thu','Fri','Sat');
    #my @months = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
    my @months = ('01','02','03','04','05','06','07','08','09','10','11','12');
    my ($sec,$min,$hour,$mday,$mon,$year,$wday) = (localtime(time))[0,1,2,3,4,5,6];
    my $time = sprintf("%02d\:%02d\:%02d",$hour,$min,$sec);
    $year += 1900;
    #return "$days[$wday] $months[$mon] $mday, $year $time";
    return "$year-$months[$mon]-$mday-$time";
}

sub log_grokker {
  my $today = get_date();
  open (GH, ">>log");
    print "$today $0: $_[0]\n" if defined $debug;
    print GH "$today $0: $_[0]\n";
  close (GH);
}

exit unless defined $debug;
my $urlcount=0;
my $emlscount=0;
for my $key (keys %links){
  #for (@{$links{$key}}){ print "key=\"$key\" value=\"$_\"\n"; }
  #print "key=\"$key\" value=\"$links{$key}\"\n";
  #print "$key\n";
  $urlcount++;  
}
print ("Total urls found: $urlcount\n");
for (keys %addy){
  #print "$_\n";
  $emlscount++;
}
print ("Total emails found: $emlscount\n");