#!/usr/bin/perl

#   Copyright (c) Peter Kirk <peterDOTkirkATgmxDOTde>, 2004
#
#   This program is free software;  you can redistribute it and/or modify
#   it under the terms of the GNU General Public License version 2 as 
#   published by the Free Software Foundation.
#  
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY;  without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See
#   the GNU General Public License for more details.
#  
#   You should have received a copy of the GNU General Public License
#   along with this program;  if not, write to the Free Software
#   Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA

use IO::Socket;
use IO::File;
use POSIX 'setsid';
use RRDs;
use warnings;
use strict;
use diagnostics;
use lib "modules";
use Tcpquery;

die "Syntax: gurugrapher path_to_put_the_gifs\n" if (@ARGV != 1);
my $DRAW_PICTURE = 1;
my $DAEMONIZE = 1;
my $DEBUG = 0;
my $DEST_DIR = $ARGV[0];
my $RRD_DIR = "rrds";
die "Bad path syntax !\n" unless($DEST_DIR =~ /[A-Za-z0-9_\/]+/);

my %playerlist = ();
my %servers = ( "test.teamspeak.org" => [ 8767 ],
				"stable.teamspeak.org" => [ 10050, 10060 ] );
my %server_labels = ( "test.teamspeak.org8767" => "Public -1-",
					"stable.teamspeak.org10050" => "Public -2-",
					"stable.teamspeak.org10060" => "Public -3-");
my @idletimes = (7200, 3600, 1800, 900, 600, 300, 60, 0);
my @args = ();
my $ERR;


mkdir($RRD_DIR, 0700);

#create the databases
unless(IO::File->new("$RRD_DIR/teamspeak-users-total.rrd")) #file exists...
{
	@args = ("$RRD_DIR/teamspeak-users-total.rrd", "--step", "120",
				"DS:users:GAUGE:600:U:U", "RRA:AVERAGE:0.5:1:1400",  "RRA:AVERAGE:0.5:7:1400",
				"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
				"RRA:MAX:0.5:360:1400" );
	RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
	print "We did rrdtool create @args\n" if($DEBUG);
}


foreach my $server (keys %servers)
{
	foreach my $port (@{$servers{$server}})
	{
		next if(IO::File->new("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd")); #file exists...
		@args = ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd", "--step", "120",
					"DS:users:GAUGE:600:U:U", "RRA:AVERAGE:0.5:1:1400",  "RRA:AVERAGE:0.5:7:1400",
					"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
					"RRA:MAX:0.5:360:1400" );
		RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
		print "We did rrdtool create @args\n" if($DEBUG);
	}
}

foreach my $server (keys %servers)
{
	foreach my $port (@{$servers{$server}})
	{
		next if(IO::File->new("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd")); #file exists...
		@args = ("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd", "--step", "120");
		for(my $j = 0; $j < @idletimes; $j++)
		{
			push @args, "DS:idle_morethan_$idletimes[$j]:GAUGE:600:U:U";
		}
	
		push @args, ("RRA:AVERAGE:0.5:1:1400",  "RRA:AVERAGE:0.5:7:1400",
					"RRA:AVERAGE:0.5:360:1400", "RRA:MAX:0.5:1:1400", "RRA:MAX:0.5:7:1400",
					"RRA:MAX:0.5:360:1400" );
		RRDs::create(@args); $ERR=RRDs::error; die "rrdtool create @args failed: $ERR" if $ERR;
		print "We did rrdtool create @args\n" if($DEBUG);
	}
}


while(1)
{
	
	#get data
	my %users = ();
	my %idlers = ();
	my @idler_row = ();
	foreach my $server (keys %servers)
	{
		foreach my $port (@{$servers{$server}})
		{
			my $previous_includes = 0;
			$users{$server.$port} = get_usercount($server, $port, 0);
			for(my $j = 0; $j < @idletimes; $j++)
			{
				$idler_row[$j] = get_usercount($server, $port, $idletimes[$j]) - $previous_includes;
				$previous_includes = $previous_includes + $idler_row[$j];
			}
			$idlers{$server.$port} = [ @idler_row ];
		}
	}
	
	#fill data into database
	my $total_users = 0;
	foreach my $server (keys %servers)
	{
		foreach my $port (@{$servers{$server}})
		{
			@args = ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd", "N:$users{$server.$port}");
			RRDs::update(@args); $ERR=RRDs::error; die "rrdtool update @args failed: $ERR" if $ERR;
			print "We did rrdtool update @args\n" if($DEBUG);
			$total_users += $users{$server.$port};

			@args = ("$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd");
			my $string_to_push = "N";
			for(my $j = 0; $j < @idletimes; $j++)
			{
				$string_to_push = $string_to_push . ":$idlers{$server.$port}[$j]";
			}
			push @args, $string_to_push;
			RRDs::update(@args); $ERR=RRDs::error; die "rrdtool update @args failed: $ERR" if $ERR;
			print "We did @args\n" if($DEBUG);
		}
	}

	@args = ("$RRD_DIR/teamspeak-users-total.rrd", "N:$total_users");
	RRDs::update(@args); die "rrdtool update @args failed: $ERR" if $ERR;
	print "We did rrdtool update @args\n" if($DEBUG);

	%idlers = ();
	%users = ();
	%playerlist = ();
	
	#make picture
	if($DRAW_PICTURE)
	{
		@idletimes = reverse @idletimes;
		foreach my $mode ("daily", "weekly", "yearly")
		{
			my @args = ();
			my $timeslice = 120 * 1400;
			$timeslice *= 7 if($mode eq "weekly");
			$timeslice *= 360 if($mode eq "yearly");
		
			my $rrds = "rrds";
			my $variables = "variables";
			my $colours = "colours";
			my $linecolour = "linecolour";
			foreach my $string ($rrds, $variables, $colours, $linecolour)
			{
				$string = "y".$string if($mode eq "yearly");
			}
			my $whitespace = 1.1; #leave 10 % whitespace *over* the graph
		
			my @total_rrds = ();
			foreach my $server (keys %servers)
			{
				foreach my $port (@{$servers{$server}})
				{
					push @total_rrds, "$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd";
				}
			}
			my @idlervars = ();
			for(my $i = 0; $i < @idletimes; $i++)
			{
				my $length = "";
				if($i + 1 < @idletimes)
				{
					$length = "less than ".readable_timeslice($idletimes[$i + 1], 1);
				}
				else
				{
					$length = "more than ".readable_timeslice($idletimes[$i], 1);
				}
				my $allignment = "";
				if(length("Users idle $length") < 35)
				{
					for(my $j  = 0; $j < 35 - length("Users idle $length"); $j++)
					{
						$allignment = $allignment." ";
					}
				}
				push @idlervars, [ ("idle_morethan_$idletimes[$i]", "AVERAGE", "Users idle $length$allignment\\J") ];
			}
			my %total = ("title" => "Total # of users on TeamSpeak Publics 1, 2 and 3",
						"rrds" => [ @total_rrds ],
						"variables" => [ [ ("users", "AVERAGE", "Users Public -SUBiSUB-") ] ],
						"colours" => [ ("#3be5d1", "#3ce08b", "#9cdb3d") ],
						"linecolour" => "#000001",
						"ycolours" => [ ("#afafaf", "#000001") ],
						"yrrds" => [ ("$RRD_DIR/teamspeak-users-total.rrd") ],
						"yvariables" => [ [ ("users", "MAX", "Total user count") ], [ ("users", "AVERAGE", "Average user count") ] ],
						"ylinecolour" => "#000000",
						"gif" => "$DEST_DIR/teamspeak-users-total-$mode.gif");
			my @pubs = ();
			foreach my $server (keys %servers)
			{
				foreach my $port (@{$servers{$server}})
				{
					push @pubs, {"title" => "# of users on TeamSpeak ".$server_labels{$server.$port},
								"rrds" => [ "$RRD_DIR/teamspeak-idlers-$server"."_"."$port.rrd" ],
								"variables" => [ @idlervars ],
								"colours" => [ reverse ("#a3182d", "#db551c", "#d89715", "#f9b42a", "#f9ee0e", "#caf90e", "#69f90e", "#59c119") ],
								"linecolour" => "#000000",
								"ycolours" => [ ("#afafaf", "#000001") ],
								"yrrds" => [ ("$RRD_DIR/teamspeak-users-$server"."_"."$port.rrd") ],
								"yvariables" => [ [ ("users", "MAX", "Total user count") ], [ ("users", "AVERAGE", "Average user count") ] ],
								"ylinecolour" => "#000000",
								"gif" => "$DEST_DIR/teamspeak-idlers-$server"."_"."$port-$mode.gif"};
				}
			}
		
			foreach my $what (\%total, @pubs)
			{
				@args = ($what->{"gif"}, "--start", "-$timeslice",
					"-v", "total # of users", "--width", "640", "--height", "250", "-X", "0", "-i",
					"-t", $what->{"title"});
				print "Now doing $mode - of ".$what->{"title"}."\n";
				for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
				{
					for(my $j = 0; $j < @{$what->{$variables}}; $j++)
					{
						my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
						$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
						my $num = (($i + 1) * ($j + 1)) - 1;
						push @args, "DEF:unclean_$striped_var$num=".$what->{$rrds}[$i].":".
							$what->{$variables}[$j][0].":".$what->{$variables}[$j][1];
		
						my $add_up_string = "0";
						for(my $sub_i = 0; $sub_i <= $i; $sub_i++)
						{
							for(my $sub_j = 0; $sub_j <= $j; $sub_j++)
							{
								my $striped_var = $what->{$variables}[$sub_j][0].$what->{$variables}[$sub_j][1];
								$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
								my $sub_num = (($sub_i + 1) * ($sub_j + 1)) - 1;
								$add_up_string = $add_up_string . ",$striped_var$sub_num,+";
							}
						}
						push @args, "CDEF:$striped_var$num=unclean_$striped_var$num,UN,0,unclean_$striped_var$num,IF";
						push @args, "CDEF:total_$striped_var$num=$add_up_string";
					}
				}
		
				for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
				{
					for(my $j = 0; $j < @{$what->{$variables}}; $j++)
					{
						my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
						$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
						my $num = (($i + 1) * ($j + 1)) - 1;
						my $count = $num + 1;
						my $label = $what->{$variables}[$j][2];
						$label =~ s/SUBiSUB/$count/;
						my $usewhat = "STACK";
						$usewhat = "AREA" if($i == 0 && $j == 0);
						$usewhat = "LINE2" if(($i > 0 || $j > 0) && $mode eq "yearly");
						push @args, "$usewhat:$striped_var$num".$what->{$colours}[$num % @{$what->{$colours}}].":$label";
					}
				}
		
				for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
				{
					for(my $j = 0; $j < @{$what->{$variables}}; $j++)
					{
						my $striped_var = $what->{$variables}[$j][0].$what->{$variables}[$j][1];
						$striped_var =~ s/idle_morethan//; #fix broken length stuff i guess.
						my $num = (($i + 1) * ($j + 1)) - 1;
						push @args, "LINE1:total_$striped_var$num".$what->{$linecolour};
					}
				}
				#Calculating max point, average, last updated
				my $peak = 0;
				my $average = 0;
				my $datapoints = 0;
				my $peaktime = 0;
				my $upperlimit = 0;
				my $last_updated = 0;
		
				my @start = ();
				my @step = ();
				my @names = ();
				my @data = ();
		
				my @do_these = ("AVERAGE");
				@do_these = ("MAX", "AVERAGE") if($mode eq "yearly");
		
				foreach my $selection (@do_these)
				{
					$average = 0;
					$datapoints = 0;
					$last_updated = 0;
					@start = ();
					@step = ();
					@names = ();
					@data = ();
					for(my $i = 0; $i < @{$what->{$rrds}}; $i++)
					{
						($start[$i],$step[$i],$names[$i],$data[$i])=RRDs::fetch($what->{$rrds}[$i],$selection, "--start", "-$timeslice");	# Get MAX points
					}
					next unless($data[0] && $start[0]);
					for(my $i = 0; $i < @{$data[0]}; $i++) #go through values
					{
						my $tot_value = 0;
						foreach my $diag (@data) #go through diagramms
						{
							for(my $j = 0; $j < @{$diag->[$i]}; $j++)
							{
								$tot_value += ${$diag}[$i][$j] if(${$diag}[$i][$j]);
							}
						}
						if($tot_value >= $peak)
						{
							$peak = $tot_value;
							$peaktime = $start[0];
						}
						if($tot_value > 0)
						{
							$datapoints++;
							$average += $tot_value;
							$last_updated = $start[0];
						}
						$start[0] += $step[0];
					}
				}
		
				$peak=sprintf("%.f",$peak);	# Round the connection number
				$average=sprintf("%.f",$average/$datapoints) if($datapoints);
				$average="0" unless($datapoints);
				$upperlimit = sprintf("%.f",$peak*$whitespace);
		
				push @args, "COMMENT:\\s";
				push @args, "COMMENT:\\s";
				push @args, "COMMENT:\\s";
				if($peak && $peaktime)
				{
					push @args, "HRULE:$peak\#FF0000:User peak in the last ".readable_timeslice($timeslice, 1)."was";
					push @args, "COMMENT:$peak on ".localtime($peaktime)."";
					push @args, "COMMENT:\\s";
					push @args, "COMMENT:\\s";
					push @args, "COMMENT:\\s";
				}
				if($average)
				{
					push @args, "HRULE:$average\#1920e5:User average in the last ".readable_timeslice($timeslice, 1)."was";
					push @args, "COMMENT:$average";
					push @args, "COMMENT:\\s";
					push @args, "COMMENT:\\s";
					push @args, "COMMENT:\\s";
				}
				if($last_updated)
				{
					push @args, "COMMENT:Last update: ".localtime($last_updated)."\\r";
				}
				else
				{
					push @args, "COMMENT:Last update: No update yet\\r";
				}
				push @args, "--lower-limit=0";
				push @args, "--upper-limit=$upperlimit";
				RRDs::graph(@args); $ERR=RRDs::error; die "rrdtool graph @args failed: $ERR" if $ERR;
				print "We did rrdtool graph @args\n" if($DEBUG);
			}
		}
		@idletimes = reverse @idletimes;
	}
	if($DAEMONIZE)
	{
		daemonize();
		$DAEMONIZE = 0;
	}
	sleep(120);
}

sub get_usercount # server, port, idletime greater or equal than n (seconds)
{
	if(@_ != 3)
	{
		warn "Called get_usercount with wrong parameter count, aborting...\n";
		return 0;
	}
	my $server = $_[0];
	my $port = $_[1];
	my $idle_time = $_[2];
	$playerlist{$server.$port} = get_playerlist($server, $port) unless exists($playerlist{$server.$port});
	return 0 if ($playerlist{$server.$port} == 0);

	my $count = 0;
	for(my $i = 0; $i < @{$playerlist{$server.$port}}; $i++)
	{
		$count++ if($playerlist{$server.$port}[$i][9] >= $idle_time); #9 == idle time
	}
	return $count;
}

sub get_playerlist
{
	if(@_ != 2)
	{
		warn "Called getplayerlist with the wrong parameter count, aborting...\n";
		return 0;
	}
	my $server = $_[0];
	my $port = $_[1];
	my $sock = Tcpquery::login($server, $port);
	unless($sock)
	{
		warn "Couldnt connect to tcpredirect server\n";
		return 0;
	}
	my $returnme = [ Tcpquery::getplayerlist($sock) ];
	print $sock "quit\n";
	return $returnme;	
}

sub readable_timeslice
{
	if(@_ < 1 || @_ > 2)
	{
		warn "Give readable_timeslice one argument, or two.\n";
		return "0";
	}
	my $simple_output = 0;
	$simple_output = 1 if(@_ == 2);
	my $number = $_[0];
	my $returnstring = "";
	my $second = 1;
	my $minute = 60 * $second;
	my $hour = 60 * $minute;
	my $day = 24 * $hour;
	my $week = 7 * $day;
	my $month = 30 * $day;
	my $year = 12 * $month;
	my $value = 0;

	$value = ($number - ($number % $year)) / $year;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value years ";
		$number = $number - $value * $year;
	}
	$value = ($number - ($number % $month)) / $month;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value months ";
		$number = $number - $value * $month;
	}
	$value = ($number - ($number % $week)) / $week;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value weeks ";
		$number = $number - $value * $week;
	}
	$value = ($number - ($number % $day)) / $day;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value days ";
		$number = $number - $value * $day;
	}
	$value = ($number - ($number % $hour)) / $hour;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value hours ";
		$number = $number - $value * $hour;
	}
	$value = ($number - ($number % $minute)) / $minute;
	if($value > 1)
	{
		$returnstring = $returnstring . "$value minutes ";
		$number = $number - $value * $minute;
	}
	$value = ($number - ($number % $second)) / $second;
	if($value > 0)
	{
		$returnstring = $returnstring . "$value seconds ";
		$number = $number - $value * $second;
	}
	if($simple_output)
	{
		if($returnstring =~ /^(\d+\s+\w+\s)/)
		{
			$returnstring = $1;
		}
	}
	return $returnstring;
}

sub daemonize 
{
	open STDIN, '/dev/null' or die "Can't read /dev/null: $!";
	open STDOUT, '>/dev/null' or die "Can't write to /dev/null: $!";
	defined(my $pid = fork) or die "Can't fork: $!";
	exit if $pid;
	setsid or die "Can't start a new session: $!";
    open STDERR, '>&STDOUT' or die "Can't dup stdout: $!";
}