#!/usr/bin/perl
#
# $Id: BLAMd.pl,v 1.5 2005/08/29 12:20:17 seb Exp $
#
# Robot d'analyse de la tribune pour compter les '_o/* BLAM !'
# postés sur la tribune LinuxFR
#

use encoding "iso 8859-15";	# Le code est écrit en ISO
use strict;			# On veut pouvoir se relire demain
use HTTP::Cache::Transparent;	# Cache the result of http get-requests persistently.
use LWP::Simple;		# Simple procedural interface to LWP
use XML::Parser;		# A perl module for parsing XML documents
use Time::Local;		# Efficiently compute time from local and GMT time
use DBI;			# Database independent interface for Perl
use Data::Dumper;		# Stringified perl data structures

#####################################################################################
# Paramétrage
#####################################################################################

# URL du back-end
my $URL="http://linuxfr.org/board/remote.xml";
#my $URL="file:///tmp/remote.xml";

# Pause minimale et maximale
my $SLEEP_MIN = 15;      # 15 secondes
my $SLEEP_MAX = 60 * 30; # 30 minutes

# Taille du BackEnd conservé
my $BACKEND_SIZE = 50;

# Plage pour le calcul du refresh
my $LASTTIME = 10;

# Paramêtres de la base de données
my $DB_DATASOURCE = "dbi:Pg:dbname=XXXXXX;host=XXXXXX";
my $DB_USER = "XXXXXX";
my $DB_PASS = "XXXXXX";

# Couleurs, les séquences ANSI sont codées directement comme un porc (du quebec)
my $ESC_NORMAL = "\033[0m";
my $ESC_BOLD = "\033[1m";
my $ESC_RED = "\033[1;31m";
my $ESC_GREEN = "\033[1;32m";
my $ESC_CLOCK = "\033[1;42;38m";


#####################################################################################
# Initialisation
#####################################################################################
HTTP::Cache::Transparent::init( {
	BasePath => "/tmp/perl-http-cache", # Directory to store the cache in.
	Verbose  => 0                       # Print progress-messages to STDERR. Default is 0.
} )
	or die "Erreur lors du paramétrage du cache: $!\n";
                                                                                                                                                                                                                                    
my $parser = new XML::Parser(Handlers => {
	Init    => \&xml_init,
	Start   => \&xml_start,
	End     => \&xml_end,
	Char    => \&xml_char,
	},
	ParseParamEnt => 1)
	or die "Impossible d'initialiser le parser: $!\n";

my $db = DBI->connect($DB_DATASOURCE, $DB_USER, $DB_PASS, { RaiseError => 1, AutoCommit => 0 } )
        or die "Erreur de connexion à la BdD: $!\n";
my $ins = $db->prepare("SELECT blamd_update(?,?,?)")
	or die "Erreur lors de la préparation de la requête: $!\n";


#####################################################################################
# Variables
#####################################################################################
# Liste des messages
my @backend = ();

# Nouveau message
my @newmsg = ();

# Dernière ID considérée
my $lastid = 0;

# Durée de pause calculée et delta sur $LASTTIME
my $sleep = 30;
my $delta;

# Go
print clock(), $ESC_BOLD, "Initialisation\n", $ESC_NORMAL;
@backend = parseBackEnd( loadBackEnd( $URL ) );
$lastid = $backend[0]->{'id'};
print clock(), "Dernière ID du backend : ", $ESC_BOLD, $lastid, $ESC_NORMAL, "\n";

# Boucle
while( 1 ) {

	# Calcul du nouveau interval
	calculDelai();

	# Pause
	print clock(), "Pause de $sleep sec. (delta $delta sec)\n";
	sleep( $sleep );
	
	# Lecture du back-end
	#DEBUG# print clock(), "Lecture du back-end\n";
	@newmsg = parseBackEnd( loadBackEnd( $URL ) );
	next if( scalar( @newmsg ) == 0 );	
	
	# Fusion des nouveaux messages dans le backend
	fusionBackEnd( @newmsg );

	# Recherche des BLAM
	traiteBLAM( @newmsg );
	
	# Réduit le BackEnd
	tronqueBackEnd( $BACKEND_SIZE );	
}

#####################################################################################
# Retourne une horloge
#####################################################################################
sub clock() {
	my( $sec, $min, $hour, $mday, $mon, $year, $wday, $yday, $isdst ) = localtime();
	return sprintf "%s%.4i-%.2i-%.2i %.2i:%.2i:%.2i%s ", $ESC_CLOCK, $year+1900, $mon+1, $mday, $hour, $min, $sec, $ESC_NORMAL;
}


#####################################################################################
# Recherche les BLAMs
#####################################################################################
sub traiteBLAM($) {
	my ($msg, $txt, @msg, $score, $match);
	my $REG_CLOCK = '\d\d[:h\.]\d\d(?:[:m\.]\d\d)?';
	my $REG_BLAM  = '_[o0@Oo'."ÒòÓóÔôÕõÖöø".']/+\s*\W*\s+BLAM';
	my $REG_SPLIT = '\s(?='.$REG_CLOCK.'\W{0,2}\s)';
	
	#DEBUG# print "REG_CLOCK=\"", Dumper($REG_CLOCK), "\"\n";
	#DEBUG# print "REG_BLAM=\"", Dumper($REG_BLAM), "\"\n";
	#DEBUG# print "REG_SPLIT=\"", Dumper($REG_SPLIT), "\"\n";
	
	while( $msg = shift(@_) ){
	
		# Recherche un BLAM, supprime les balises
		$txt = $msg->{'message'};
		$txt =~ s/<\/?\w+.*?>//g;
		unless( $txt =~ /$REG_BLAM/io ) {
			print clock(), $ESC_BOLD, "MSG JETÉ   ", $msg->{'login'}, $ESC_NORMAL, "> \"", $txt, "\"\n" if ( $txt =~ /BLAM/i );
			next;
		}
		print clock(), $ESC_BOLD, "MSG GARDÉ  ", $msg->{'login'}, $ESC_NORMAL, "> \"", $txt, "\"\n";
		
		# Recherche de l'horloge
		@msg = split( m/$REG_SPLIT/io, $txt );
		while( $txt = shift(@msg) ) {
		
			# Seuls ceux qui contiennent le BLAM nous intéressent
			next unless ( $txt =~ /$REG_BLAM/io );
			
			# Recherche de l'horloge
			$txt =~ /($REG_CLOCK)/io;
			
			# Calcul du score	
			$score = score( $txt, $1 );
			
			# Commit
			enregistre( $msg->{'login'}, $score, $msg->{'info'} );
			print clock(), "  ", $msg->{'login'}, " a écrit \"$txt\" pour ($1): ",
				( $score > 0 ? $ESC_GREEN : $ESC_RED ), $score, " points$ESC_NORMAL\n";
			
		}
	}
}


#####################################################################################
# Charge le backend dans une structure mémoire
#####################################################################################
sub loadBackEnd($) {
	return get( $_[0] );
}


#####################################################################################
# Elements du parser
#####################################################################################

my $xml_obj;	# Objet post en cours de création
my $xml_str;	# Chaine de caractères en cours de lecture
my @xml_posts;	# Element lus

#####################################################################################
# Parse le backend dans une structure mémoire
#####################################################################################
sub parseBackEnd($) {

	my $be = shift;

	$parser->parse( $be );

	#DEBUG# print "MESSAGES : ", Dumper( \@xml_elem );

	return @xml_posts;
}

#####################################################################################
# Tronque le BackEnd à la taille maximale
#####################################################################################
sub tronqueBackEnd($) {

	# Le backend est trop court
	#DEBUG# print "Taille du backend: ", scalar(@backend), "\n";
	return if( scalar(@backend) <= $_[0] );
	
	# Supprime les vieux messages
	splice @backend, $_[0], $_[0];
	#DEBUG# print "Nouvelle taille du backend: ", scalar(@backend), "\n";
}

#####################################################################################
# Fusionne les nouveaux messages dans le backend
#####################################################################################
sub fusionBackEnd($) {

	#DEBUG# print "Taille du backend: ", scalar(@backend), " taille de newmsg: ", scalar(@_),  "\n";
	#DEBUG# print "BACKEND : ", Dumper( \@backend ), "\n";
	#DEBUG# print "NEWMSG : ", Dumper( \@_ ), "\n";

	# Lit les éléments par la fin de la liste
	my ( $tmp, $id );
	while( $tmp = pop(@_) ) {
		# A-t'on perdu un élément
		$id = $tmp->{'id'};
		if( $lastid+1 < $id ) {
			print clock(), $ESC_RED, "Perte d'IDs !!! On passe de $lastid à $id !!!\n", $ESC_NORMAL;
		}
		unshift @backend, $tmp;
		$lastid = $id
	}
}

#####################################################################################
# Callbacks du parser
#####################################################################################

# This is called just before the parsing of the document starts.
#   (Expat)
sub xml_init() { 
	# Vide la liste des éléments lus
	@xml_posts = (); 
}

# This event is generated when an XML start tag is recognized.
#   (Expat, Element [, Attr, Val [,...]])
sub xml_start() {
	
	my( @tmp, %tmp );
	
	# Lit les attributs du message
	if ( $_[1] eq 'post' ) {
		# Récupère les attributs (paramêtres 2..n)
		@tmp = (@_);
		splice @tmp, 0, 2;
		#DEBUG# print Dumper( @_, '|||', @tmp );
		%tmp = ( @tmp );
		$xml_obj = \%tmp;
	}
	
	# Initialise le texte qui remonte
	elsif( $_[1] eq 'info' || $_[1] eq 'message' || $_[1] eq 'login' ) {
		$xml_str = "";
	}
}

# This event is generated when an XML end tag is recognized.
#   (Expat, Element)
sub xml_end() { 

	# Sauvegarde le message dans la liste
	if( $_[1] eq 'post') { 
		push @xml_posts, $xml_obj if ( $lastid < $xml_obj->{'id'} ) ;
		#DEBUG# print "Ajout de ", Dumper( $xml_obj ), "\n";
	}
	
	# Sauvegarde le texte associé dans la clef correspondante
	elsif( $_[1] eq 'info' || $_[1] eq 'message' || $_[1] eq 'login' ) {
		$xml_obj->{$_[1]} = trim($xml_str);
	}
}

# This event is generated when non-markup is recognized.
#   (Expat, String)
sub xml_char() {
	if ( $_[1] =~ /^\s*$/ ) {
		$xml_str .= ' ';
	} else {
		#DEBUG# print "xml_str = \"$_[1]\"\n";
		$xml_str .= $_[1];
	}
}


#####################################################################################
# Calcul du nouveau délai de retour
#####################################################################################
sub calculDelai() {
	
	# Début du calcul
	my $lasttime = $backend[$LASTTIME]->{'time'};
	
	#DEBUG# print "Considération du post time = \"$lasttime\"\n";
	
	my $intdate = timelocal(
		substr( $lasttime, -2, 2 ),
		substr( $lasttime, -4, 2 ),
		substr( $lasttime, -6, 2 ),
		substr( $lasttime, 6, 2 ),
		substr( $lasttime, 4, 2 ) - 1,
		substr( $lasttime, 0, 4 )
	);
	
	# Temps depuis le post considéré
	$delta = time() - $intdate;
	$sleep = int(( ($sleep * 100) + ($delta * 100) + (min($sleep,$delta) * 200)) / 400);
	$delta = $delta / $LASTTIME;
	
	# Valeurs extremes
	$sleep = $SLEEP_MAX if ( $sleep > $SLEEP_MAX );
	$sleep = $SLEEP_MIN if ( $sleep < $SLEEP_MIN );
}

#####################################################################################
# Retourne le min d'une liste
#####################################################################################
sub min() {
	my $min = shift();
	while( shift() ) { $min = $_ if ( $min > $_ ); }
	return $min;
}

#####################################################################################
# Normalise les espaces
#####################################################################################
sub trim($) {
	$_[0] =~ s/\s+/ /;
	$_[0] =~ s/^ +//;
	$_[0] =~ s/ +$//;
	return $_[0];
}

#####################################################################################
# Calcul le score d'un BLAM
#####################################################################################
sub score($$) {

	# Pas d'horloge = -5
	# Horloge inexistante = -3
	# Ok = +1
	
	my $msg = shift;
	my $horloge = shift;
	my $score = 0;
	
	# Pas d'horloge
	if( $horloge eq undef ) {
		$score -= 5;
	} else {
		$horloge =~ s/[^\d]//g;
		$horloge = "^20......$horloge";
		#DEBUG# print clock(), "  Horloge recherchée: $horloge\n";
		$score -= 3;
		foreach (@backend) {
			if ( $_->{'time'} =~ /$horloge/ ) {
				#DEBUG# print clock(), "  Horloge trouvée: +1\n";
				$score += 4;
				last;
			}
		}
				
	}
	
	return $score;
}

#####################################################################################
# Stocke le score d'un BLAM dans la base de donnée
#####################################################################################
sub enregistre($$$) {

	# 0: Login
	# 1: Score
	# 2: UA

	#DEBUG# print Dumper(\@_), "\n";
	$ins->execute( $_[0], $_[1], $_[2] )
		or warn "Erreur EXEC base de donnée: $!";
	$db->commit()
		or warn "Erreur COMMIT base de donnée: $!";
}