#!/usr/bin/perl
#
# $Id: split-bs.pl,v 1.3 2001/05/23 19:04:32 he Exp $
#

# Copyright (c) 2001, NORDUnet.  All rights reserved.
# 
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions
# are met:
# 1. Redistributions of source code must retain the above copyright
#    notice, this list of conditions and the following disclaimer.
# 2. Redistributions in binary form must reproduce the above copyright
#    notice, this list of conditions and the following disclaimer in the
#    documentation and/or other materials provided with the distribution.
# 3. Neither the name of NORDUnet nor the names
#    of its contributors may be used to endorse or promote
#    products derived from this software without specific prior
#    written permission.
#
# THIS SOFTWARE IS PROVIDED BY NORDUnet ``AS IS'' AND ANY EXPRESS OR
# IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
# WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
# ARE DISCLAIMED.  IN NO EVENT SHALL NORDUnet OR THEIR CONTRIBUTORS
# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
# EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED
# TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
# DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON
# ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR
# TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF
# THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
# SUCH DAMAGE.
#

#
# Split beacon status into individual files, and generally
# massage the data as returned by e.g.
#
#  http://beaconserver.accessgrid.org:9999/


# Threshold above which failure to receive or be heard is
# attributed to be associated with the local beacon
$perc_thresh = 50;

# Refresh after this many seconds:
$refresh = 600;



sub read_table {
    my($table_seen) = 0;
    my($row_seen) = 0;
    my($name, $i, $num);

    while(<>) {
	if (/<table/i) {
	    $table_seen = 1;
	} elsif (/Beacons: <B>(\d+)<\/B>/i && !$table_seen) {
	    $beacons = $1;
	} elsif (/<tr/i && !/colspan=2>Loss/ && $table_seen) {
	    $row_seen = 1;
	} elsif (/<a name=(\d+)/ && $row_seen) {
	    $num = $1;
	    if (/\"right\">(.*)<\/td>/i) {
		$name = $1;
		$name =~ s/<b>//;
		$name =~ s/<\/b>//;
	    }
	    $name[$num] = $name;
	    $num{$name} = $num;
	    $i = 0;
	} elsif (/<TD [^>]+>([^<]+)<\/TD>/ && $row_seen) {
	    $receive{$name}[$i++] = $1;
	} elsif (/<\/TR>/i && $row_seen) {
	    $row_seen = 0;
	} elsif (/<\/TABLE>/i) {
	    $table_seen = 0;
	}
    }
}

sub tweak_na {
    my($r, $i);

    foreach $r (keys %receive) {
	for ($i = 0; $i < $beacons; $i++) {
	    if ($receive{$r}[$i] eq "NA") {
		$receive{$r}[$i] = 100;
	    }
	}
    }
}

sub process_table {
    my($r, $n, $i, $rec);
    my(@ord, $s);

    &tweak_na();

    foreach $r (keys %receive) {
	$n = $num{$r};
	$sumr[$n] = 0;
	$sumt[$n] = 0;
	$sumt10[$n] = 0;
	$sumtna[$n] = 0;
	$sumr10[$n] = 0;
	$sumrna[$n] = 0;
	foreach $r2 (keys %receive) {
	    $rec = $receive{$r2}[$n];
	    $sumt[$n] += (100 - $rec);
	    if ($rec < 10) {
		$sumt10[$n]++;
	    }
	    if ($rec == 100) {
		$sumtna[$n]++;
	    }
	}
	for ($i = 0; $i < $beacons; $i++) {
	    $rec = $receive{$r}[$i];
	    $sumr[$n] += (100 - $rec);
	    if ($rec < 10) {
		$sumr10[$n]++;
	    }
	    if ($rec == 100) {
		$sumrna[$n]++;
	    }
	}
    }
    for ($i = 0; $i < $beacons; $i++) {
	if ($sumtna[$i] < $beacons*$perc_thresh/100) {
	    $o_loss[$i] = ((100 * $beacons) - $sumt[$i] - $sumtna[$i]*100)
		/ $beacons;
	    $o10_loss[$i] = ($beacons - $sumt10[$i] - $sumtna[$i])
		* 100 / $beacons;
	} else {
	    $o_loss[$i] = ((100 * $beacons) - $sumt[$i])
		/ $beacons;
	    $o10_loss[$i] = ($beacons - $sumt10[$i])
		* 100 / $beacons;
	}
	if ($sumrna[$i] < $beacons*$perc_thresh/100) {
	    $m_loss[$i] = ((100 * $beacons) - $sumr[$i] - $sumrna[$i]*100)
		/ $beacons;
	    $m10_loss[$i] = ($beacons - $sumr10[$i] - $sumrna[$i])
		* 100 / $beacons;
	} else {
	    $m_loss[$i] = ((100 * $beacons) - $sumr[$i])
		/ $beacons;
	    $m10_loss[$i] = ($beacons - $sumr10[$i])
		* 100 / $beacons;
	}
	$missedby[$i] = $sumtna[$i] * 100.0 / $beacons;
	$wemiss[$i] = $sumrna[$i] * 100.0 / $beacons;
    }
    for ($i = 0; $i < $beacons; $i++) {
	$rankpts[$i] = 0;
    }
    foreach $s (\&order_by_o_loss, \&order_by_m_loss,
		\&order_by_o10_loss, \&order_by_m10_loss,
		\&order_by_missedby, \&order_by_wemiss)
    {
	@ord = &$s();
	for ($i = 0; $i < $beacons; $i++) {
	    $rankpts[$ord[$i]] += $i;
	}
    }
    @ord = &order_by_rankpts();
    for ($i = 0; $i < $beacons; $i++) {
	$rank[$ord[$i]] = $i;
    }
}

sub add_bold {
    my($n) = @_;
    my($i);
    
    $i = rindex($n, ".");
    if ($i != -1) {
	$i = rindex($n, ".", $i-1);
	if ($i != -1) {
	    return sprintf("%s<b>%s</b>",
			   substr($n, 0, $i+1),
			   substr($n, $i+1));
	}
    }

    return $n;
}

sub pick_color {
    my($val) = @_;

    if ($val < 10) {
	return "lightgreen";
    } elsif ($val < 30) {
	return "yellow";
    } elsif ($val <= 99) {
	return "red";
    } else {
	return "gray";
    }
}

sub print_res {
    my($outfile, $order, $ordstr) = @_;
    my(@ord, $val);

    open(OUT, ">$outfile") || die "Could not open $outfile for writing: $!\n";
    $out = OUT;

    print $out <<EOF
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
<head>
<title>Sorted beacon status</title>
<meta http-equiv=refresh content=$refresh>
</head>
<body>
<h1>Sorted beacon status</h1>

<h2>Input data from <a href="http://beaconserver.accessgrid.org:9999/">http://beaconserver.accessgrid.org:9999/</a>.</h2>

EOF
    ;

    printf($out "<h2>%s UTC</h2>", scalar gmtime());

    printf($out "<h2>Sorted by %s</h2>\n<p>\n", $ordstr);

    print $out <<EOF
<table border=1>
<tr bgcolor="lightblue">
    <th colspan=4>&nbsp;</th>
    <th colspan=4>Compensated</th>
    <th colspan=2>&nbsp;</th>
</tr>
<tr bgcolor="lightblue">
    <th>Rank</th>
    <th colspan=2>Beacon</th>
EOF
    ;
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/rank.html", "Over-<br>all rank"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/other.html", "Others loss"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/ourloss.html", "Our RCV loss"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/other10.html", "% RCV us w/ &gt;= 10% loss"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/our10.html", "% we RCV w/ &gt;= 10% loss"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/miss.html", "Missed by%"));
    printf($out "<th>%s</th>\n",
	   &doc_ref("doc/wemiss.html", "We miss%"));

    print $out <<EOF
</tr>    
<tr bgcolor="lightblue">
    <td>&nbsp</td>
    <th>#</th>
    <th align="center">Name</th>
    <td align="right"><a href="rank.html">sort</a></td>
    <td align="right"><a href="o_loss.html">sort</a></td>
    <td align="right"><a href="m_loss.html">sort</a></td>
    <td align="right"><a href="o10_loss.html">sort</a></td>
    <td align="right"><a href="m10_loss.html">sort</a></td>
    <td align="right"><a href="missedby.html">sort</a></td>
    <td align="right"><a href="wemiss.html">sort</a></td>
</tr>
EOF
    ;

    @ord = &$order();

    for ($i = 0; $i < $beacons; $i++) {
	print $out "<tr>\n";
	my $n = $ord[$i];
	my $r = $name[$n];

	printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $i);
	printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $n);
	printf($out "<td bgcolor=\"#ccccff\" align=\"right\">");
	printf($out "<a href=\"%s\">%s</a></td>\n",
	       &beacon_status_file($r),
	       &add_bold($r));

	foreach $val ($rank[$n],
		      $o_loss[$n], $m_loss[$n],
		      $o10_loss[$n], $m10_loss[$n],
		      $missedby[$n], $wemiss[$n])
	{
	    printf($out "<td align=\"right\" bgcolor=\"%s\">%d</td>\n",
		   &pick_color($val), $val);
	}

	printf $out "</tr>\n";
    }
    print $out "</table>\n";

    print $out <<EOF
<hr>
</body>
</html>
EOF
    ;

    close($out);
}

sub ordlist {
    my($n) = @_;
    my($i, @l);

    for ($i = 0; $i < $n; $i++) {
	$l[$i] = $i;
    }
    return @l;
}

sub order_by_o_loss {
    my(@ord) = &ordlist($beacons);

    return sort { $o_loss[$ord[$a]] <=> $o_loss[$ord[$b]] } @ord;
}

sub order_by_m_loss {
    my(@ord) = &ordlist($beacons);
    
    return sort { $m_loss[$ord[$a]] <=> $m_loss[$ord[$b]] } @ord;
}

sub order_by_o10_loss {
    my(@ord) = &ordlist($beacons);

    return sort { $o10_loss[$ord[$a]] <=> $o10_loss[$ord[$b]] } @ord;
}

sub order_by_m10_loss {
    my(@ord) = &ordlist($beacons);

    return sort { $m10_loss[$ord[$a]] <=> $m10_loss[$ord[$b]] } @ord;
}

sub order_by_missedby {
    my(@ord) = &ordlist($beacons);

    return sort { $missedby[$ord[$a]] <=> $missedby[$ord[$b]] } @ord;
}

sub order_by_wemiss {
    my(@ord) = &ordlist($beacons);

    return sort { $wemiss[$ord[$a]] <=> $wemiss[$ord[$b]] } @ord;
}

sub order_by_rank {
    my(@ord) = &ordlist($beacons);

    return sort { $rank[$ord[$a]] <=> $rank[$ord[$b]] } @ord;
}

sub order_by_rankpts {
    my(@ord) = &ordlist($beacons);

    return sort { $rankpts[$ord[$a]] <=> $rankpts[$ord[$b]] } @ord;
}

sub print_rest_of_line {
    my($fh, $bn, $ex_val) = @_;
    my($val);

    my $r = $name[$bn];

    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $bn);
    printf($out "<td bgcolor=\"#ccccff\" align=\"right\">");
    printf($out "<a href=\"%s\">%s</a></td>\n",
	   &beacon_status_file($r),
	   &add_bold($r));

    $val = $rank[$bn];
    printf($out "<td align=\"right\" bgcolor=\"%s\">%d</td>\n",
	   &pick_color($val), $val);
    
    
    if (defined($ex_val)) {
	printf($out "<td align=\"right\" bgcolor=\"%s\">%d</td>\n",
	       &pick_color($ex_val), $ex_val);
    }

    foreach $val ($o_loss[$bn], $m_loss[$bn],
		  $o10_loss[$bn], $m10_loss[$bn],
		  $missedby[$bn], $wemiss[$bn])
    {
	printf($out "<td align=\"right\" bgcolor=\"%s\">%d</td>\n",
	       &pick_color($val), $val);
    }
}

sub doc_ref {
    my($href, $text) = @_;

    return sprintf("<a href=\"%s\"
	onclick=\"window.open('%s', 'doc',
	'height=270,width=350,scrollbars=1,toolbar=1'); return false\">
		%s
	</a>", $href, $href, $text);
}

sub print_header {
    my($out, $cth) = @_;

    print $out <<EOF
<table border=1>
<tr bgcolor="lightblue">
EOF
    ;
    if (defined($cth)) {
	print $out "    <th colspan=5>";
    } else {
	print $out "    <th colspan=4>";
    }
    print $out <<EOF
&nbsp;</th>
    <th colspan=4>Overall Compensated</th>
    <th colspan=2>&nbsp;</th>
</tr>
<tr bgcolor="lightblue">
    <th>Rank</th>
    <th colspan=2>Beacon</th>
EOF
    ;
    printf($out "<th>%s</th>\n", &doc_ref("doc/rank.html",
					"Over-<br>all rank"));
    if (defined($cth)) {
	print $out  "    <th>$cth</th>\n\n";
    }
    printf($out "<th>%s</th>\n", &doc_ref("doc/other.html",
					"Others loss"));
    printf($out "<th>%s</th>\n", &doc_ref("doc/ourloss.html",
					"Our RCV loss"));
    printf($out "<th>%s</th>\n", &doc_ref("doc/other10.html",
					"% RCV us w/ &gt;= 10% loss"));
    printf($out "<th>%s</th>\n", &doc_ref("doc/our10.html",
					"% we RCV w/ &gt;= 10% loss"));
    printf($out "<th>%s</th>\n", &doc_ref("doc/miss.html",
					"Missed by%"));
    printf($out "<th>%s</th>\n", &doc_ref("doc/wemiss.html",
					"We miss%"));
    print $out "</tr>\n";
}


sub beacon_status_file {
    my($bname) = @_;

    $bname =~ s/\@/_/;
    $bname .= ".html";
    return ($bname);
}

sub print_one_beacon {
    my($out, $bn) = @_;
    my(@ord, $i, $n, $r, $x);

    print $out <<EOF
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html lang="en">
<head>
EOF
    ;
    printf($out "<title>%s beacon status</title>\n", $name[$bn]);
    print $out <<EOF
<meta http-equiv=refresh content=$refresh>
</head>
<body>
EOF
    ;

    @ord = &order_by_rankpts();

    printf($out "<h1>%s</h1>\n", $name[$bn]);

    printf($out "<h2>%s UTC</h2>", scalar gmtime());

    printf($out "<h2>Beacons we do not receive</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out);
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];

	if ($receive{$name[$bn]}[$n] == 100) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

    printf($out "<h2>Beacons who do not receive us</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out);
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];

	if ($receive{$name[$n]}[$bn] == 100) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

    printf($out "<h2>Beacons we receive with &gt; 10%% loss</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out, &doc_ref("doc/our-ind.html", "Our indiv. rcv loss"));
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];
	
	$r = $receive{$name[$bn]}[$n];
	if ($r >= 10 && $r != 100) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n, $r);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

    printf($out "<h2>Beacons who receive us with &gt; 10%% loss</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out, &doc_ref("doc/their-ind.html",
				 "Their indiv. rcv loss"));
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];

	$r = $receive{$name[$n]}[$bn];
	if ($r >= 10 && $r != 100) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n, $r);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

    printf($out "<h2>Beacons we receive with &lt; 10%% loss</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out, &doc_ref("doc/our-ind.html",
				 "Our indiv. rcv loss"));
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];

	$r = $receive{$name[$bn]}[$n];
	if ($r < 10) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n, $r);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

    printf($out "<h2>Beacons who receive us with &lt; 10%% loss</h2>\n");
    printf($out "<table border=1>\n");
    &print_header($out, &doc_ref("doc/their-ind.html",
				 "Their indiv. rcv loss"));
    $x = 1;
    for ($i = 0; $i < $beacons; $i++){
	$n = $ord[$i];

	$r = $receive{$name[$n]}[$bn];
	if ($r < 10) {
	    printf($out "<tr>\n");
	    printf($out "<td bgcolor=\"#ccccff\"><b>%d</b></td>\n", $x++);
	    &print_rest_of_line($out, $n, $r);
	    printf($out "</tr>\n");
	}
    }
    printf($out "</table>\n");

}

sub print_beacon_res {
    my($b);
    
    for($b = 0; $b < $beacons; $b++) {
	my($f) = &beacon_status_file($name[$b]);
	open(OUT, ">$f") || die "Could not open $f for write: $!\n";
	&print_one_beacon(OUT, $b);
	close(OUT);
    }
}


#
# Main
#

&read_table();
&process_table();
&print_res("o_loss.html", \&order_by_o_loss,
	   "% of loss on beacons who receive us");
&print_res("m_loss.html", \&order_by_m_loss,
	   "% of loss on beacons we receive");
&print_res("o10_loss.html", \&order_by_o10_loss,
	   "% of beacons who receive us with &gt;= 10% loss");
&print_res("m10_loss.html", \&order_by_m10_loss,
	   "% of beacons we receive with &gt;= 10% loss");
&print_res("missedby.html", \&order_by_missedby,
	   "% of beacons who do not receive us");
&print_res("wemiss.html", \&order_by_wemiss,
	   "% of beacons we do not receive");
&print_res("rank.html", \&order_by_rankpts,
	   "Overall rank");
&print_beacon_res();
