#!/usr/bin/perl -w

use strict;
use RRDs;
use Time::ParseDate;
use Compress::Zlib;

my $NOW = time;
my $VERBOSE = 0;
my $RRD = '/home/weasel/www/www.noreply.org/Build/other/mixminion/rrd/nodes.rrd';
my $RRD_DIR = '/home/weasel/www/www.noreply.org/Build/other/mixminion/rrd/nodes';
my $DIR_DIR = '/home/weasel/www/www.noreply.org/Build/other/mixminion/mixminion-directory';

sub check_exists($) {
	my ($rrd) = @_;
	return if (-e $rrd);
	my @params = ($rrd);
	push @params,  '-b', 'now - 1 year',
	 qw{ --step 14400
	  DS:inDirectory:GAUGE:172800:U:U
	  DS:recommended:GAUGE:172800:U:U
	  RRA:AVERAGE:0.5:1:21900
	};
	print "Creating rrd: $rrd...\n" if $VERBOSE;
	RRDs::create @params;
	my $err=RRDs::error;
	warn "ERROR while creating $rrd: $err\n" if $err;
}
sub get_last($) {
	my ($rrd) = @_;
	my $last = 0;
	if ( -e $rrd) {
		$last = RRDs::last($rrd);
		my $err = RRDs::error;
		warn "ERROR while getting last for $rrd: $err\n" if $err;
	};
	return $last;
};

check_exists($RRD);
my $last = get_last($RRD);

opendir(DIR, $RRD_DIR) || die ("Cannot opendir $RRD_DIR: $!\n");
my @rrdfiles = grep { /\.rrd$/ } readdir (DIR);
closedir(DIR);
my %last_node;
for my $rrdfile (@rrdfiles) {
	my $nodename = $rrdfile;
	$nodename =~ s/\.rrd$//;
	$last_node{$nodename} = get_last($RRD_DIR.'/'.$rrdfile);
}

my @dirfiles;
if (scalar @ARGV) {
	@dirfiles = @ARGV;
} else {
	opendir(DIR, $DIR_DIR) || die ("Cannot opendir $DIR_DIR: $!\n");
	@dirfiles = sort { ($a cmp $b) } grep { /^directory-/ } readdir (DIR);
	closedir(DIR);
};

my @updateGlobal;
my %updates;
for my $dir (@dirfiles) {
	print "Doing $dir\n" if $VERBOSE;
	open (DIRECTORY, $DIR_DIR.'/'.$dir) || die ("Cannot open $DIR_DIR/$dir: $!\n");
	my $compressed_dir = join '', <DIRECTORY>;
	close (DIRECTORY);

	my $directory = Compress::Zlib::memGunzip($compressed_dir);

	my $published = undef;
	my $recommended_servers = undef;
	my %in_directory;
	my %is_recommended;
	my $section = '' ;
	for my $line (split /\r?\n/, $directory) {
		chomp $line;
		if ($line =~ /^\[(.*)\]\s*$/) {
			$section = $1;
		};
		if ($section eq 'Directory' && $line =~ /^Published: (\d{4}-\d{2}-\d{2} \d{2}:\d{2}:\d{2})$/) {
			my $date = $1;
			print "Found published: $date\n" if ($VERBOSE >= 3);
			$date =~ s#/#-#g;
			$published = parsedate($date);
			print "Parsed as $published (".(gmtime $published).")\n" if ($VERBOSE >= 4);
		};
		if ($section eq 'Directory' && $line =~ m#^Published: (\d{4}/\d{2}/\d{2} \d{2}:\d{2}:\d{2})$#) {
			my $date = $1;
			print "Found published: $date\n" if ($VERBOSE >= 3);
			$date =~ s#/#-#g;
			$published = parsedate($date);
			print "Parsed as $published (".(gmtime $published).")\n" if ($VERBOSE >= 4);
		};
		if ($section eq 'Directory' && $line =~ /^Recommended-Servers: \s*(.*?)\s*$/) {
			$recommended_servers = $1
		};
		if ($section eq 'Server' && $line =~ /Nickname: ([a-zA-Z0-9_-]+)\s*$/) {
			$in_directory{$1} = 1;
		};
	}
	close (DIRECTORY);
	my @recommended_servers = split /,?\s*\s+/, $recommended_servers;
	for my $node (@recommended_servers) {
		$is_recommended{$node} = 1;
	}

	if ($published > $last) {
		push @updateGlobal, $published.':'.(scalar keys %in_directory).':'.(scalar @recommended_servers);
		$last = $published;
		print "at  ".(gmtime $published)."  there are ".(scalar keys %in_directory).' in the directory and '.(scalar @recommended_servers)." recommended servers\n" if ($VERBOSE >= 3);
	} else {
		print "ignoring data at  ".(gmtime $published)."  because it's older than  ".(gmtime $last)."\n" if ($VERBOSE >= 3);
	};
	for my $node (keys %in_directory) {
		if (!defined $last_node{$node} || $published > $last_node{$node}) {
			push @{$updates{$node}}, $published.':1:'.( defined $is_recommended{$node} ? '1' : '0' );
			$last_node{$node} = $published;
		}
		delete $is_recommended{$node};
	}
	if (scalar keys %is_recommended) {
		my $nodes = join ', ', keys %is_recommended;
		warn ("$nodes recommended but not in directory.\n");
	}
};

if (scalar @updateGlobal != 0) {
	check_exists($RRD);
	RRDs::update( $RRD, @updateGlobal );
	my $err=RRDs::error;
	warn "ERROR while updating $RRD: $err\n" if $err;
};

for my $node (keys %updates) {
	if ($node =~ /[^a-zA-Z0-9_-]/) {
		warn ("Illegal characters in node name '$node'\n");
		next;
	};
	my $rrd = $RRD_DIR.'/'.$node.'.rrd';
	check_exists($rrd);
	RRDs::update( $rrd, @{$updates{$node}} );
	my $err=RRDs::error;
	warn "ERROR while updating $rrd: $err\n" if $err;
};