#!/usr/bin/perl
# Copyright Carlos Francisco Ferry Sauterel - carlos@gnu.cl
# May 27, 2007

BEGIN {
use strict;
use warnings;
use Cwd;
use DBI;
use Net::DNS;
use Data::Dumper;
use LWP::UserAgent;
use HTML::TokeParser;
use HTML::LinkExtor;
use Term::ANSIColor qw(:constants);
use open ':utf8';
use Acme::Comment type => 'C++', one_line => 1, own_line => 0;
my $curdir = getcwd;
my $ifor=10;
my $nprintmode = 'term';
my $timeout=65;
my $identifier = "NS";
my $dfolder=$curdir . '/getemp/';
my $lfolder=$curdir . '/logs/';
my $datafolder=$curdir . '/data/';
my $server=`uname -n`;;
my $range=5000;
my $dsn = 'DBI:mysql:wildserv:localhost';
my $dusn = 'wildserv';
my $dpass = 'XXXXXXXXXXXXXXX';
my $dbh = DBI->connect($dsn, $dusn, $dpass);
$Term::ANSIColor::AUTORESET = 1;
$SIG{'INT'} = 'CLEANUP';
$SIG{HUP} = 'CLEANUP';
my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
my $time  = sprintf("%0.2d:%0.2d:%0.2d",$hour,$min,$sec);
my $date  = sprintf("%0.4d/%0.2d/%0.2d",$year+1900,++$mon,$mday);
my $ldate  = sprintf("%0.4d-%0.2d-%0.2d",$year+1900,++$mon,$mday);
my $start_timestamp = "Beginning at $time on $date";
my $timestamp = "$time - $date";
/* I make a general check */
start_check();
/* I check if mySQL works || not */
if (!$dbh) {
  nprint("E","Couldn't connect!.");
  die;
  }	 	else {
  nprint("S","Connection to mySQL established.");
}
sub start_check {
my $lfolder_status;
/* We check directories, incorrenctly named as folder in vars */
if (!chdir($lfolder)) {
$lfolder_status = "N";
mkdir($lfolder);
} else {
nprint("N","'$lfolder' exists");
chdir($curdir);
  }
nprint("N", $start_timestamp);
nprint("N","Checking software ...");
nprint("N","Checking directories ...");
if (defined($lfolder_status)) {  
if ($lfolder_status eq "N"){
nprint("E","'$lfolder' didn't exist!");
nprint("N","'$lfolder' created");
  }
}
if (!chdir($dfolder)) {
nprint("E","'$dfolder' doesn't exist!");
nprint("N","Creating '$dfolder'..");
mkdir($dfolder);
} else {
nprint("N","'$dfolder' exists");
chdir($curdir);
  } 
if (!chdir($datafolder)) {
nprint("E","'$datafolder' doesn't exist!");
nprint("N","Creating '$datafolder'..");
mkdir($datafolder);
} else {
nprint("N","'$datafolder' exists");
chdir($curdir);
  }
    
}
/* Colors in nprint: E = ERROR - S = SUCCESSFUL OPERATION - N = NORMAL OPERATION */                                                      
sub nprint {
my ($flag, $lfile, $npm);
$lfile = $lfolder . $ldate . "-logs.txt";
open PFILE, ">>$lfile" or die nprint("E","Unable to open $lfile $!");
  if ($_[0] eq "E") {
        $flag = RED;
    }
      elsif ($_[0] eq "S") {
        $flag = GREEN;
    }
      elsif ($_[0] eq "N") {
        $flag = YELLOW;
  }
  
        #PFILE                                                                                                                               
  print  $flag . '[' . $identifier . '][' . $timestamp . ']-> '  . $_[1] . "\n", RESET;
 close PFILE;                                                                                                                                                  
}     
sub work_words {
open( FILE, "< $_[0]" ) or die "Can't open $_[0] : $!";


close FILE;
}
sub get_ahref {
my $p;
my $url_from = $_[0];
my $parse = $_[1];
$p = HTML::LinkExtor->new(\&cb, $url_from);
$p->parse_file($parse);
sub cb {
  my ($counter, $tcounter, $sth, $vid);
  my($tag, $ref,  $link) = @_;
  if ($tag eq "a" && $ref eq "href") {
  $sth = $dbh->prepare(qq{ select id from `linkers` where url_from = ? and url_to = ? });
  $sth->execute($_[0], $link);
  $vid = $sth->fetchrow_array();
  
  /* I check if it was added, if not, I'll upload it to mySQL, otherwise it won't be added */
  if (!defined($vid))
 {
  $sth = $dbh->prepare(qq{ insert into `linkers` (url_from, url_to) values (?, ?) });
  $sth->execute($_[0], $link);
  }
  #print "$link\n";
  print "$_[0]\n";
  #print "@{[%links]}\n";
  #push @links, "@{[%links]}\n";  
    }
  }
}

sub clean_protocol {
my $url = $_[0];
my ($protocol);
my @protocols_allowed = 'http https ftp';
my @protocols_splited = map {split ' '} @protocols_allowed;
  foreach $protocol (@protocols_splited)
  {
   if ($url =~ /$protocol:\/\//) 
    {
     $url =~ s/^$protocol:\/\///m;
    }
  }

$url =~ s/\/$//m;
return $url;
}

sub get_description {
my $content;

my $p = HTML::TokeParser->new($_[0]);
while ( my $tag = $p->get_tag("meta") ) {
 if ( defined( $tag->[1]{'name'} )) {
   if($tag->[1]{'name'} eq "description") {
       $content = $tag->[1]{'content'}
        }
    };
}
/* I'm going to try to get description by  h1 ;-) */
  if (!defined($content)) {
   
    $p = HTML::TokeParser->new($_[0]);
           if ($p->get_tag("h1")) {
                   $content = $p->get_trimmed_text;                             
         }  
   }
return  $content;
}
sub get_dns {
my $basedomain = $_[0];
if ($basedomain =~ /\/$/) {
$basedomain =~ s/\/$//g;
}
#print "$basedomain !\n";
my $res   = Net::DNS::Resolver->new;
my $query = $res->search($basedomain);
my $dns;     
my $status;
    if ($query) {
       foreach my $rr ($query->answer) {
          next unless $rr->type eq "A";
                 $dns = $rr->address; 
                 $status = "Y";           
            nprint("S","DNS: $basedomain -> " . $rr->address);
                                    }
                             } else {
            nprint ("E","DNS query failed: $res->errorstring");
             $status = "N";
              }
return ($status,$dns);
         


}
sub get_title {
my $title;
my  $p = HTML::TokeParser->new($_[0]);
       if ($p->get_tag("title")) {
          $title = $p->get_trimmed_text;
            if (defined($title)) {
                  return $title;
             }
        }
                                                
}  
sub wget {
my ($status, $rnumber, $wget_outfile, $response);
my $read_size = ":read_size_hint"; 
   $rnumber =  rand($range);
   $wget_outfile = $dfolder . $rnumber . '.html'; 
   my $ua = LWP::UserAgent->new;
   $ua->agent('Mozilla/5.0');	
   $ua->protocols_allowed( [ 'http', 'ftp', 'https'] );
   $ua->from('carlos@gnu.cl');
   $ua->timeout($timeout);
   $ua->env_proxy;
   nprint("N","Ready to download $_[0] ");
   $response = $ua->get($_[0]);
    if ($response->is_success) {
       open OUT, "> $wget_outfile" or exit nprint("E","Can't open $wget_outfile : $!");
       nprint("S",$response->status_line);
       print OUT $response->content;
       close OUT;
       $status = "S"; 
 return ($status,$wget_outfile);
               
                    }
else {
   nprint("E","Something wrong happened while processing $_[0]");
   nprint("E",$response->status_line);
   $status = "N";
   return $status;
                               }

}
                                  
sub fetch {
my $cleaned_url = clean_protocol($_[0]);
my $sth;

#A function which recognizes how often does a webpage changes should be here, read carlos castillo tesis.
$sth = $dbh->prepare(qq{ update  `update` SET `ip` = 'Y', `sv` = '$server'  where url = ? });
$sth->execute($_[0]);
my ($dns_status, $dns) = get_dns($cleaned_url);
  if ($dns_status eq "N") {
    nprint("E","Couldn't reverse $_[0], trying next page");
# A function which sets this domain for tomorrow should be here.
   } 
   else 
   { 
my ($line, @fline, @url_links, $p);
my ($downl_status, $downl_file) = wget($_[0]);
#VALUE RETURNED SHOULD INDICATE: N = NOT SUCCESSFUL OPERATION, S = SUCCESSFUL OPERATION.
  if ($downl_status eq "N")
  {
    &nprint("E","Error!");
  }
  else 
  {
    nprint("S","$_[0] downloaded successfully.");
    open( FILE , "< $downl_file" ) or die nprint("E","Can't open $downl_file : $!");
    nprint("N","Opening $downl_file ..");
      foreach $line (<FILE>)
      {
      push @fline, $line;
      }

close FILE;

my $webtitle = get_title($downl_file);
#my @webalinks = get_alinks($downl_file,$_[0]);
#print @webalinks;

  if (defined($webtitle)) 
  {
  print "$webtitle <- title\n";
  }
  
my $webdesc = get_description($downl_file);
  if (defined($webdesc))
  {
  print "$webdesc\n";
  }
get_ahref($_[0],$downl_file);


#ACA DEBERIA IR EL UPLOADER
# Here should be a nice math function whichr recognizes where to make the next update. (consultar tesis de castillo)
#$sth = $dbh->prepare(qq{ update  `update` SET next_date = DATE_ADD(CURDATE(), INTERVAL +7 DAY) where url = ? });
#$sth->execute($_[0]);
# We set the update to inprogress N.
#delete($downl_file);
  }
} 
$sth = $dbh->prepare(qq{ update  `update` SET `ip` = 'N', `sv` = 'N' where url = ? and `sv` = '$server' });
$sth->execute($_[0]);

}

sub CLEANUP {
my $sth;
nprint ("N","Caught Interrupt, Aborting.");
$sth = $dbh->prepare(qq{ update  `update` SET `ip` = 'N', `sv` = 'N' where `sv` = '$server' });
$sth->execute();
$sth->finish();
exit(1);
}
sub autonomous_fetch {
my $sth;
my $readytofetch;
my $instances=10;
my @urls_to_fetch;
my $wbfc;
my $seconds=10;
# ip = inprogress
$sth = $dbh->prepare(qq{ select url  from `update` where `ip` = 'N' and next_date = '0000-00-00' or next_date <= CURDATE() and `ip` = 'N' order by rand() limit $instances });
$sth->execute();
#fork and exit;
  while (defined(my $willbefetched = $sth->fetchrow_array())) {
  #fork
  fetch($willbefetched);
  #exit
  }

$sth->finish();
}

sub run_nucleous {
autonomous_fetch();
#run_nucleous();
}

run_nucleous();
      

}