#!/usr/bin/perl
# Copyright Carlos Francisco Ferry Sauterel - carlos@gnu.cl
# Baalux0.1: March 29, 2007
# Baalux0.2: May 27, 2007
BEGIN { 
use strict;
use warnings;
use Cwd;
use DBI;
use Net::DNS;
use Data::Dumper;
use LWP::UserAgent;
use Lingua::Identify qw/langof/;
use CGI qw(:standard);
use HTML::TokeParser;
use HTML::SimpleLinkExtor;
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 = 'XXXXXXXXX';
/*
my $dsn = 'DBI:mysql:carlosf_wildserv:www.elite-team.cl';
my $dusn = 'carlosf_wildserv';
my $dpass = 'XXXXXXXX';
*/
my $dbh = DBI->connect($dsn, $dusn, $dpass);
no warnings "recursion";
$Term::ANSIColor::AUTORESET = 1;
$SIG{'INT'} = 'CLEANUP';
$SIG{'HUP'} = 'CLEANUP';

if (defined($ARGV[0]) && $ARGV[0] eq "stop")
{
CLEANUP();
}
/* I make a general check */
start_check();
/* I check if mySQL works || not */

if (!$dbh) 
{
die "Error:" . $dbh->errstr . "\n";
}
else 
{
nprint("S","Connection to mySQL established.");
}

sub start_check {
my $lfolder_status;
nprint("N","Starting.");
/* 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","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 ($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 $timestamp = "$time - $date";
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;
  }
  elsif ($_[0] eq "F") {
          $flag = CYAN;
            }
                                                                                                                                                   
  print PFILE  $flag . '[' . $identifier . '][' . $timestamp . ']-> '  . $_[1] . "\n", RESET;
 close PFILE;                                                                                                                                                  
}     

sub get_words {
my @words;
my $downl_file = $_[0];
my @text = $_[2];
my $url = $_[1];
my $c;
my $line_n;
my $word;
my $sth;
my $V;
my $outfile;
#open( FILEX, "< $filename" ) or die "Can't open $filename : $!";
my $i;
#my @webtitle = get_title($downl_file);
my @webdesc = get_description($downl_file);
my @furl = map {split '\.|\/'} $url;
#my @wholetext = dump_html($_[0]);
for ($i=0;$i < 50;$i++){
push @text, get_description($downl_file);
}
for ($i=0;$i < 5;$i++){
push @text, @webdesc;
}
for ($i=0;$i < 50;$i++){
push @text, @furl;
}
push @text, $url;
push @text, dump_html($_[0]);
#print "@text\n";
#chomp(@texty);
foreach my $l (@text)
{
if (defined($l)) 
{
/* Aca irian todos los saltadores */
next if $l =~ /^(\s)*$/;
 if ($l =~ /[A-Z]/)
 {
 $l = lc($l);
 }
# my $llength = length($l); 
# next if $llength eq 2;
 push @words, $l;
}
#undef @wholetext;
my @sfinal_words = map {split ' '} @words;
#undef @words;
my @final_words = map {split '-|_|,'} @sfinal_words;
#undef @sfinal_words;
$outfile = $downl_file . '.words.html';
open OUT, "> $outfile" or die nprint("E","Couldn't open $outfile :$!");
foreach $V (@final_words) {
$c++;
print OUT $V . "\n";
}
foreach  $V (@final_words) {
$line_n++;
     foreach my $tain (@final_words) {
    if ($V eq $tain) {
    $word++;
    }
}
my $tf = ($word*100)/$c;
my $f = ($tf * $tf);
$sth = $dbh->prepare(qq{ select  id FROM `words` where word = ?  and url = ? });
$sth->execute("$V","$url");
my $idu_number = $sth->fetchrow_array();    
if (!defined($idu_number)) {
$sth = $dbh->prepare(qq{ insert into `words` (url, word, density, repeated, last_date) values (?, ?, ?, ?, CURDATE()) });
$sth->execute("$url","$V","$f","$word");

} else {
 /* ya taba! */
 }
undef $f;
undef $word;
undef $tf;
undef $idu_number; 
} 
close OUT;  
unlink($outfile);  
  }
nprint("N","$line_n words were found.");
}

#close FILEX;


sub get_ahref {
my $sth;
my $url_from = $_[1];
my ($c, $nc, $t);
my $extor = HTML::SimpleLinkExtor->new($url_from);
$extor->parse_file(shift);
my @a_hrefs = $extor->a;

$sth = $dbh->prepare(qq{ delete from `linkers` where url_from = ? });
$sth->execute("$url_from");
foreach $a (@a_hrefs) {
if ($a =~ /[A-Z]/) {
$a = lc($a);
}
/* solucion temporal (mostly javascript) */
next if $a =~ /^mailto:/;
next if $a =~ /^javascript:/;
next if $a =~ /#/;
next if $a =~ s/^(.*)\.mp3$//;

/* eliminamos soporte a los pdf */

next if $a =~ s/^(.*)\.pdf$//;
$sth = $dbh->prepare(qq{ select id from `linkers` where url_to = ? and url_from = ? });
$sth->execute("$a","$url_from");
my $link_id = $sth->fetchrow_array();
if (!defined($link_id) && "$a" ne "$url_from") 
{
$sth = $dbh->prepare(qq{ insert into `linkers` (url_to, url_from) values (?, ?) });
$sth->execute("$a","$url_from");
}

$sth = $dbh->prepare(qq{ select id from `update` where url = ? });
$sth->execute("$a");
my $update_id = $sth->fetchrow_array();
if (!defined($update_id)) {
$sth = $dbh->prepare(qq{ insert into `update` (url, next_date) values (?, 0000-00-00) });
$sth->execute("$a");
}


   
undef $link_id;
undef $update_id;
  }
  
}

sub clean_protocol {
my $url = $_[0];
$url =~ s/^(.*):\/\///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_erank {
my $co;
my $erank;
my $sth;
$sth = $dbh->prepare(qq{ select url_from from `linkers` where url_to = ?  });
$sth->execute("$_[0]");
while (defined(my $url_from = $sth->fetchrow_array())) {
$co++;
}
if (!defined($co)) {
$erank = 0.0000000003;
} else {
$erank = $co * 0.000000004;
}
if ($erank > 10) {
$erank=10;
} 
return $erank;
}

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"; 
          my $filesize = -s $wget_outfile;
       
 return ($status,$wget_outfile,$filesize);
               
                    }
else {
   nprint("E","Something wrong happened while processing $_[0]");
    nprint("E",$response->status_line);
    $status = "N";
    return $status;
                               }

}
sub get_lang {
my @lang;
my $langfilename = $_[0];
open( FILEL, "< $langfilename" ) or nprint ("E","Can't open $langfilename : $!");

foreach my $line (<FILEL>) {
push @lang, $line;
}
close FILEL;
  my $text = join "\n", @lang;
  my $language = langof($text);

  return $language;
}
sub dump_html {
my @dumped  = ` lynx -dump -nolist  -nonumbers -dont_wrap_pre $_[0]`;
return @dumped;
}                                  
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");
/* It didn't resolve, I'll try again in 2 days. */
  $sth = $dbh->prepare(qq{ update  `update` SET next_date = DATE_ADD(CURDATE(), INTERVAL +2 DAY) where url = ? });
  $sth->execute($_[0]);
   } 
   else 
   { 
my ($line, @fline, @url_links, $p);
my ($downl_status, $downl_file, $filesize) = wget($_[0]);
#VALUE RETURNED SHOULD INDICATE: N = NOT SUCCESSFUL OPERATION, S = SUCCESSFUL OPERATION.
  if ($downl_status eq "N")
  {
 &nprint("E","Error!, trying to fetch it in 72 days");
 $sth = $dbh->prepare(qq{ update  `update` SET next_date = DATE_ADD(CURDATE(), INTERVAL +72 DAY) where url = ? });
 $sth->execute($_[0]);
  }
  else 
  {
    nprint("S","$_[0] downloaded successfully: " . $filesize * 0.000976562499 . " KB");

my $webtitle = get_title($downl_file);  
my $webdesc = get_description($downl_file);
/* aca deberia ir una opcion porq si es .pdf lo mande a dump_pdf, quizas sera necesario q todas las funciones (dump_html, get_lang, get_erank) 
sean una variable dependiendo si es .pdf o .html ($dump, $lang), etc*/
my @dumped = dump_html($downl_file);
my $lang = get_lang($downl_file);
my $erank = get_erank($_[0]);
get_ahref($downl_file,$_[0]);
get_words($downl_file,$_[0],@dumped);
$sth = $dbh->prepare(qq{ select id from `indexed` where url = ? });
$sth->execute("$_[0]");
my $url_id = $sth->fetchrow_array();

if (!defined($url_id)) {

$sth = $dbh->prepare(qq{ insert into `indexed` (url, webtext, webdesc, language, title, rank) values (?, ?, ?, ?, ?, ?) });
$sth->execute("$_[0]", "@dumped", "$webdesc", "$lang", "$webtitle","$erank");
nprint("S","New url $_[0] Added to the DB.");
} else {
$sth = $dbh->prepare(qq{ update `indexed` set webtext = ?, webdesc = ?, language = ?, title = ?, rank = ? where url = ?  });
$sth->execute("@dumped","$webdesc","$lang","$webtitle","$erank","$_[0]");
nprint("S","url $_[0] Updated in the DB.");
}

unlink($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 +17 DAY) where url = ? });
$sth->execute($_[0]);
# We set the update to inprogress N.
#delete($downl_file);
nprint("F","$_[0] -> All done"); 
  }
} 
$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();
print "Successfully stoped.\n";
exit(1);
}
sub autonomous_fetch {
#fork and exit;
my $sth;
my $readytofetch;
my $instances=10;
my @urls_to_fetch;
my $wbfc;
my $seconds=10;

/* ip = inprogress */
$sth = $dbh->prepare(qq{ select distinct url from `update` where url like '%.cl%' and  next_date <= CURDATE() and `ip` = 'N' order by rand() limit $instances });

$sth->execute();
  while (defined(my $willbefetched = $sth->fetchrow_array())) {
  fetch($willbefetched);
  }  
$sth->finish();
}

sub run_nucleous {
autonomous_fetch();
/* Recursive */
#autonomous_fetch();
run_nucleous();
  
}
my $i;
#fork and die;
for ($i=0;$i < 4;$i++) {
#fork;
run_nucleous();
  }
/* BEGIN {'s end */
}