#!/usr/bin/perl -w
use strict;

#
# $Id: hitparades.pl,v 1.2 2004/04/20 19:48:55 eric Exp $
#

use LWP::UserAgent;
use XML::Simple;
use Data::Dumper;
use CGI;

$| = 1;

my $cgi = new CGI;

my $ua = new LWP::UserAgent;
$ua->agent('DPC-Hitparade-ControleBot/0.2; <eric@xyrion.org>, <nightbird@dutchpowercows.org>; ' . $ua->agent);
$ua->timeout(30);

my $project_to_find = getProjectAbbr($cgi->param('project'));
my %regexes = getRegex($project_to_find);

my @maand = ('januari', 'februari', 'maart', 'april', 'mei', 'juni', 'juli', 'augustus', 'september', 'oktober', 'november', 'december');
my (undef, undef, undef, $d, $m, undef, undef, undef, undef) = localtime(time-86400);
my $datum = sprintf("%d %s", $d, $maand[$m]);

my $req = new HTTP::Request(GET => 'http://gathering.tweakers.net/xml/list_topics/5');
my $res = $ua->request($req);
if($res->is_success) {
	my $data = $res->content;
	$data =~ s/ISO-8859-15/ISO-8859-1/g;
	my $xml = XMLin($data);
	my $recent;
	foreach my $topic (@{$xml->{'section'}->{'output_result'}->{'sections'}->{'section'}}) {
		foreach my $project (keys %regexes) {
			if ($topic->{'topic_name'} =~ $regexes{$project}) {
				my $url = $topic->{'topic_listmessageslink'};
				my $id = $topic->{'topic_id'};
				my $date = $topic->{'topic_name'};
				$date =~ s/^.*parade van\s?//i;
				if (!defined($$recent{$project}) || !defined($$recent{$project}{'id'}) || $id>$$recent{$project}{'id'}) {
					$$recent{$project}{'url'} = $url;
					$$recent{$project}{'id'}  = $id;
					$$recent{$project}{'date'} = $date;
				}
			}
			$$recent{$project}{'date'} ||= 'not found';
		}
	}
	if ($project_to_find && defined($regexes{$project_to_find})) {
		if (defined($$recent{$project_to_find}) && defined($$recent{$project_to_find}{'url'})) {
			print $cgi->redirect($$recent{$project_to_find}{'url'});
		} else {
			print $cgi->header;
			print $cgi->start_html;
			print 'Hitparade van '.$project_to_find.' niet gevonden in de topiclist.';
			print $cgi->end_html;
		}
	} else {
		print $cgi->header;
		print $cgi->start_html;
		foreach (sort { $$recent{$a}{'id'} <=> $$recent{$b}{'id'} } keys %$recent) {
			my $line = $$recent{$_}{'date'};
			if ($$recent{$_}{'url'}) {
				$line .= ': <a href="'.$$recent{$_}{'url'}.'">'.$_.'</a>';
			} else {
				$line .= ': '.$_;
			}

			if ($$recent{$_}{'date'} =~ /week \d+/i) {
				print $line;
			} elsif ($$recent{$_}{'date'} !~ /\Q$datum\E/i) {
				print '<i>'.$line.'</i>';
			} else {
				print $line;
			}
			print "<br/>\n";
		}
		print $cgi->end_html;
	}
} else {
	print $cgi->header;
	print $cgi->start_html;
	print "Hmm, ligt GoT weer plat ofzo?<br />\nError: ".$res->status_line."<br />\n";
	print $cgi->end_html;
}

sub debug {
	my ($string) = @_;
	my $debug;
	if ($debug) {
		my ($sec,$min,$hr,undef,undef,undef,undef,undef) = localtime;
		printf("[%02d:%02d:%02d] %0s<br>\n", $hr, $min, $sec, $string);
	}
}

sub getProjectAbbr {
	my ($param) = @_;
	my $abbr = $param || '';
	$abbr = lc($abbr);
	$abbr =~ s/\@/a/g;
	$abbr =~ tr/a-z0-9//cd;
	$abbr = 'r72'  if $abbr =~ /^r(?:c5)?-?(?:72|64)?$/;
	$abbr = 'o25'  if $abbr =~ /^o(?:gr)?-?(?:24|25|26)?$/;
	$abbr = 'seti' if $abbr =~ /^s(?:eti)?ah(?:ome)?$/;
	return $abbr;
}

sub getRegex {
	my ($project) = @_;
	my %regexes;
	my %all_regexes = (
#		'o24'		=> qr/^\[OGR-?24\][\- ]+hitparade van/i,
#		'udgrid'	=> qr/^\[UD[\- ]Grid\][\- ]+(?:hit)?parade van/i,
#		'df'		=> qr/^\[D(?:istributed )?Folding\][\- ]+hitparade van/i,
#		'fad'		=> qr/^\[FaD\][\- ]+hitparade van/i,
#		'o25'		=> qr/^\[OGR-?25\][\- ]+hitparade van/i,
#		'o26'		=> qr/^\[OGR-?26\][\- ]+hitparade van/i,
		'o27'		=> qr/^\[OGR-?27\][\- ]+hitparade van/i,
		'r72'		=> qr/^\[RC5(?:-72)?\][\- ]+hitparade van/i,
		'seti'		=> qr/^\[(?:BOINC )?SETI\@Home\][\- ]+hitparade van/i,
		'fah'		=> qr/^\[Folding\@Home\][\- ]+hitparade van/i,
		'd2ol'		=> qr/^\[D2OL\][\- ]+hitparade van/i,
		'tsc'		=> qr/^\[TSC\][\- ]+hitparade van/i,
		'sob'		=> qr/^\[SoB\][\- ]+hitparade van/i,
		'dpad'		=> qr/^\[DPAD\][\- ]+hitparade van/i,
		'rah'		=> qr/^\[Rosetta\@Home\][\- ]+hitparade van/i,
		'ufl'		=> qr/^\[.+Fluids\@Home\][\- ]+hitparade van/i,
		'wcg'		=> qr/^\[World Community Grid\][\- ]+hitparade van/i,
		'ldc'		=> qr/^\[Leiden Classical\][\- ]+hitparade van/i,
		'cpdn'		=> qr/^\[(?:CPDN|Climate Prediction)\][\- ]+hitparade van/i,
		'pg'		=> qr/^\[(?:PG|Prime ?Grid)\][\- ]+hitparade van/i,
		'stampede'	=> qr/^\[Stampede(?: [IVX]+)?\][\- ]+hitparade van/i,
	);
	
	if (defined($project) && defined($all_regexes{$project})) {
		$regexes{$project} = $all_regexes{$project};
	} else {
		%regexes = %all_regexes;
	}
	return %regexes;
}