#!/usr/bin/perl

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.1.1  - 2013-09-18
### Contact: sebastian.enger@gmail.com
###########################

package Crawler::Basic;
use Crawler::Config;

use strict;
use LWP::UserAgent;
use HTTP::Request::Common qw(GET);
use HTTP::Cookies;
use LWP::Simple;
use HTTP::Status ();
use File::Path qw(make_path);
use HTML::StripTags qw(strip_tags);
use HTML::Entities;
use URI;

my %AlreadyScanned = ();
my $AlreadyScanned;

my $D;
my %D = ();

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Konstruktor
###########################
sub new {
	my ($class) = @_;
	
	my $config = Crawler::Config->new();
	my $self = {
	#	'kontostand' => $inKontostand,
		'config' => $config,
	};
	bless $self, $class;
  
  return $self;
}

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: HTML Dokumente abholen
###########################
sub fetch(){

	my $self	= shift;
	my $url 	= shift;
	return if $url !~ m/^(http|https|ftp|ftps)/ig;
	
	my $CookieFile 	= $self->{config}->{CookieFile};
	my $ScannedFile = $self->{config}->{ScannedFile};
	my $max_retry 	= 30;
	my $sleep 		= 60;
	
	if (exists $AlreadyScanned{$url} || exists $D{$url} ){
		warn "$self->$url wurde schon gescannt\n";
		return 0;
	}
	
	my $ua = LWP::UserAgent->new();
		
		$ua->timeout(180);
		$ua->max_redirect( 10 );
		
		# Define user agent type
		$ua->agent('Mozilla/5.0 (compatible; Googlebot/2.1; +http://www.google.com/bot.html)');
	
		# Cookies
		$ua->cookie_jar(
			HTTP::Cookies->new(
				file => $CookieFile,
				autosave => 1,
			)
		);

	while($max_retry>0){	
		# Request object
		my $req = GET $url;

		# Make the request
		my $res = $ua->request($req);
	
		if ($res->is_error) {
			printf "$self->Fetching $url -> Error Code: [%d] %s\n", $res->code, $res->message;
			$max_retry--;
			sleep $sleep;
		}
		
		if ( $res->is_success ){
			 
			open(W,"+>>$ScannedFile");
				print W "$url\n";
			close W;
					 
			return $res->content;		 
		}
	}
	return 0;
} # sub fetch(){


###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Server, auf dem Mysql läuft testen, ob SQL erreichbar ist
###########################
sub check(){
	
	### Check sollte den Server anfragen stellen, der den SQL DB enthält
	
	my $max_retry 				= 30;
	my $sleep 					= 30;
	
	my $length_of_randomstring 	= 512; # the length of the random string to generate

	my @chars = ('a'..'z','A'..'Z','0'..'9','_');
	my $random_string = "";
	
	foreach (1..$length_of_randomstring){
		# rand @chars will generate a random 
		# number between 0 and scalar @chars
		$random_string .= $chars[rand @chars];
	}
	
	my $ua = LWP::UserAgent->new;
	$ua->timeout(10);
	
	while($max_retry>0){	
		my $response = $ua->get("http://www.nookiestar.com/alive.php?id=$random_string");

		if ($response->is_error) {
			printf "Error: [%d] %s\n", $response->code, $response->message;

			# record the timeout
			if ($response->code == HTTP::Status::HTTP_INTERNAL_SERVER_ERROR) {
				# later: socket: phprestart
				$max_retry--;
				print "HTTP 500 -> HTTP_INTERNAL_SERVER_ERROR: waiting $sleep second\n";
				sleep $sleep;
			}
		}
		
		if ( $response->content =~ /online/ig ){
			return 1;
		}
		
		if ( $response->content =~ /offline/ig ){
			$max_retry--;
			print "Mysql Database has gone away: waiting $sleep second\n";
			sleep $sleep;
		}
	}
	return 0;
}

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Array Einträge eineindeutig filtern 
###########################
sub uniq (@) {
    # From CPAN List::MoreUtils, version 0.22
    my %h;
    map { $h{$_}++ == 0 ? $_ : () } @_;
}



###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Links aus einem HTML Dokument extrahieren
###########################
sub links(){
	
	my $self 		= shift;
	my $content		= shift;
	my $base 		= shift;
	my @links 		= ();
	
	my $LX 			= HTML::LinkExtractor->new();
    $LX->parse(\$content);
	
    for my $Link( @{ $LX->links } ) {
		if( $self->{basic}->checkKeyword($$Link{_TEXT}) == 1 ) {
			my $fin_uri = URI->new_abs($$Link{href}, $base);
			push @links, $fin_uri;
		}
    }
	
	my @unique = uniq( @links );
	return \@unique;
} #sub links(){

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: HTML Tags aus einem HTML Dokument entfernen
###########################
sub stripHtml(){
		
	my $self 			= shift;
	my $html 			= shift;
	
	my $config 			= $self->{config};
	my $isRead 			= $config->param(-block=>"Content");

	my $allowed_tags 	= $isRead->{allowed_tags};
	my $html 			= decode_entities($html);
	
	return strip_tags( $html, $allowed_tags );
}

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Matching Keywords mit den Trend Keywords der Config Datei überprüfen
###########################
sub checkKeywords(){
	
	my $self 	= shift;
	my $input 	= shift;
	
	my $config 	= $self->{config};
	my $isRead 	= $config->param(-block=>"KeywordListingGerman");
	
	while ( my ($key, $value) = each(%{$isRead}) ) {
     #   print "$key => $value\n";
		if ( $input =~ m/$value/ig || $input eq $value ){
			return 1;
		}
    }	
	return 0;
}

###########################
### Autor: Sebastian Enger / B.Sc. 
### Copyright: Sebastian Enger
### Licence: Commercial
### Version: 1.2.0  - 2013-09-28
### Contact: sebastian.enger@gmail.com
### Aufgabe: Erstelle die Rohdaten für die Darstellung der Keyword Cloud
###########################
sub makeCloud(){

	my $self 	= shift;
	my $content	= shift;
	my $url		= shift;
	
	my (@woerter, %zaehler, @return) = ();
	my @woerter = ($content =~ m/\w+/g);

	# Wortverteilung
	foreach my $w ( @woerter ) {
		chomp $w;
		$w =~ s/^\s+//ig;
		$w =~ s/\s+$//ig;
		$zaehler{$w}++;
	}
	
	#print 'insgesamt ' . (scalar @woerter) . " woerter\nverteilung:\n";
	for my $wort (sort {$zaehler{$b} <=> $zaehler{$a}} keys %zaehler){
	#	print "$wort : ". $zaehler{$wort} . " : $url\n";
		push(@return, "$wort:". $zaehler{$wort} . ":$url\n");
	}
	return \@return;
}