#!/usr/bin/perl -w
use strict;
$|=1;

use EVEcommon;
use POSIX qw(strftime);
use Time::HiRes qw ( time );
my $begin = time;

my $opt_d = 'eve';
my $opt_u = 'eve';
my ($opt_p, $opt_h,);

use Getopt::Long qw(:config no_ignore_case bundling);
GetOptions(
	'd=s' => \$opt_d, # db name
	'u=s' => \$opt_u, # db user
	'p=s' => \$opt_p, # db pass
	'h=s' => \$opt_h, # html output file
	);

use DBI;
my $dbh = DBI->connect("DBI:mysql:database=$opt_d", $opt_u, $opt_p);
die "cant connect to db: ".DBI->errstr unless $dbh;


use CGI qw/ :standard /;
my $s = param('s') || "public";
my $l = param('l') || ($s =~ /^\d+$/ ? -1 : 1);

my $servcon = "where public=1";
if ($s eq 'all') {
	$servcon = "";
} elsif ($s =~ /^(\d+)$/) {
	$servcon = "where id = $1";
}

my $sth = $dbh->prepare(qq{
		select
			*
		from 
			server
		$servcon
		}) or die $dbh->errstr;
$sth->execute() or die $sth->errstr;
my $serv = $sth->fetchall_hashref('id');
$sth->finish();

use CGI qw/:standard *table /;
if ($opt_h) {
	open(OF, ">", "$opt_h.new") or die "cant open $opt_h.new: $!";
	select OF;

} else {
	print header;
}

print start_html("Server Versions"), "\n",
	h1("Server versions"),"\n";

my @var = ("ID", "Server", "LastOK", "Users", "Ver. Since",);
@var = ("First", "Last",) if $l != 1;
my $header = start_table({border=>2,})."\n".
		Tr(th([@var, "Version", "Build", "Branch", "Protocol","Patches from..."]))."\n";


use POSIX qw(strftime);
my $today = strftime("%Y-%m-%d", gmtime);


my $sth_getvers;
for my $sid (sort {$a <=> $b} keys %$serv) {
	my $s = $serv->{$sid};
	die "sid vanished: $sid" unless $s;

	if ($l == 1) {
		print $header;
		$header = "";
	} else {
		print h3("Server(".$s->{id}."): ".&get_servernamelink($s)." @ ".
				$s->{ip}.":".$s->{port}),"\n",$header;
	}

	my $sth = $sth_getvers ||= $dbh->prepare(qq{
			select
				*
			from
				version
			where
				server = ?
			order by
				last desc
			}) or die $dbh->errstr;
	$sth->execute($sid) or die $sth->errstr;

	my $c = $l;
	while ($c--) {
		my $v = $sth->fetchrow_hashref();
		last unless $v;

		my @val = ("", "",);
		if ($l == 1) {
			@val = (
				$s->{id},
				div({title=>$s->{ip}.":".$s->{port},}, &get_servernamelink($s)),
				((($s->{lastok}||"") =~ /^(\d+-\d+-\d+) (\d\d:\d\d):/) 
					? ("$1" eq $today) 
						? div({title=>$s->{lastok},},"$2")
						: div({title=>$s->{lastok},},"$1")
					: $s->{lastok}),
				((($s->{status}||"") =~ /^ok, (\d+) users$/) 
					? "$1" 
					: $s->{status}),
				((($v->{first}||"") =~ /^(\d+-\d+-\d+) (\d\d:\d\d):/) 
					? ("$1" eq $today) 
						? div({title=>$v->{first},},"$2")
						: div({title=>$v->{first},},"$1")
					: $v->{first}),
				);
		} else {
			@val = ( (($v->{first} =~ /^(\d+-\d+-\d+) /) 
						? div({title=>$v->{first},},"$1") 
						: $v->{first}),
				(($v->{last} =~ /^(\d+-\d+-\d+) /) 
						? div({title=>$v->{last},},"$1") 
						: $v->{last}),);
		}

		$v->{version} ||= "n/a";
		$v->{macho} ||= "n/a";

		print Tr({align=>'right',},td([
			@val,
			$v->{version},
			$v->{build},
			$v->{branch},
			$v->{macho},
			],),
			td({align=>'left',},
				&get_patchlinks($v->{build}),),
			), "\n";
	}
	$sth->finish;
	print(end_table,"\n") if $l != 1;
}
print(end_table, "\n") if $l == 1;

my $runtime = time - $begin;
print hr, "\n",
	strftime("Updated at %Y-%m-%d %H:%M:%S", gmtime),br, "\n",
        $runtime ? sprintf "Completed in %.3f sec.", $runtime : "",br,"\n",
	end_html,"\n";

if ($opt_h) {
	close(OF);
	if (-e $opt_h) { unlink $opt_h or die "cant unlink $opt_h: $!"; }
	rename "$opt_h.new", $opt_h or die "cant rename to $opt_h: $!";
}

exit 0;

sub get_servernamelink ($) {
	my ($S,) = @_;
	return a({href=>"servers?s=".$S->{id},}, $S->{name},);
}


my %pcache = ();
sub get_patchlinks ($) {
	my ($to,) = @_;
	return $pcache{$to} if $pcache{$to};

	my $sth = $dbh->prepare_cached(qq{
			select
				distinct old,
				url,
				bytes,
				date(last),
				md5,
				sha1
			from
				patch
			where
				new = ?
			order by old asc
			}) or die $dbh->errstr;
	$sth->execute($to) or die $sth->errstr;
	my $p = $sth->fetchall_arrayref();
	$sth->finish();

	my @links = ();
	for (@$p) {
		my ($from, $url, $bytes, $date, $md5, $sha1,) = @$_;
		my $title = sprintf "lastseen %s, size %s", 
				$date, &prettybyte($bytes);
		if ($md5) {
			$title .= ", md5 $md5";
		}
		my $lnk = a({href=>$url,title=>$title,}, $from);

		if ($bytes < 2**20) {
			$lnk .= "(".&get_rtplink($from,$to,$url).")";
		}
		push @links, $lnk;
	}

	return $pcache{$to} = join " ", @links;
}

sub get_rtplink ($$) {
	my ($from, $to, $url,) = @_;
	return $pcache{$url} if $pcache{$url};

	my $base = $url;
	$base =~ s,/[^/]+$,/,;
	my $suff = ($base =~ /test/i) ? "_TEST" : "";

	my $sth = $dbh->prepare_cached(qq{
			select
				version
			from
				version
			where
				build = ?
			order by last desc
			}) or die $dbh->errstr;
	$sth->execute($from) or die $sth->errstr;
	my $fv = $sth->fetchall_arrayref();
	$sth->finish();

	$sth->execute($to) or die $sth->errstr;
	my $tv = $sth->fetchall_arrayref();
	$sth->finish();

	# EVEPREMIUM.6.10.80627-6.10.80627_TEST.RTP
	my $file = sprintf "EVEPREMIUM.%.2f.%i-%.2f.%i%s.RTP",
			$fv->[0][0], $from,
			$tv->[0][0], $to,
			$suff;

	my $lnk = a({href=>"$base$file",title=>"JUST GUESSING!",}, "RTP");

	return $pcache{$url} = $lnk;
}


exit 0;