From a2de5f03f80a50fc058d3f087c3a19385f7ea365 Mon Sep 17 00:00:00 2001
From: =?utf8?q?Franti=C5=A1ek=20Dvo=C5=99=C3=A1k?= <valtri@civ.zcu.cz>
Date: Fri, 9 Mar 2012 20:06:44 +0100
Subject: [PATCH] First version of dashboard.

---
 dashboard.pl | 266 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 266 insertions(+)
 create mode 100755 dashboard.pl

diff --git a/dashboard.pl b/dashboard.pl
new file mode 100755
index 0000000..e567078
--- /dev/null
+++ b/dashboard.pl
@@ -0,0 +1,266 @@
+#! /usr/bin/perl -w
+use strict;
+use POSIX qw(strftime);
+
+my ($list, @list, %list, $item, @item, %item, $result, %platforms, %components, %ins, %upg, $now, $n_platforms, $width);
+my (%list_perf);
+
+
+sub table2($$$) {
+	my ($perf, $list, $components) = @_;
+	my ($item, $class, %list, $result);
+
+	%list = %$list;
+	print qq(<table class="cert">
+	<tr class="cert">
+		<th class="cert"></th>
+);
+	foreach my $p (sort keys %platforms) {
+		print "		<th class=\"cert\">$p</th>\n";
+	}
+	print "	</tr>\n";
+	foreach my $c (sort keys %{$components}) {
+		print "	<tr class=\"cert\">\n		<th class=\"cert\">$c</th>\n";
+		foreach my $p (sort keys %platforms) {
+			$item=$list{$c}{$p};
+			if (defined $item) {
+				if ($perf) {
+					$class = 'cert';
+					$result = $item->{result2};
+					#$result =~ s/ /<br\/>/g;
+				} else {
+					$result = $item->{result};
+					if ($item->{result} eq '0') { $class='OK'; }
+					else { $class='FAIL'; }
+				}
+				print "		<td class=\"$class\"><span class=\"date\">$item->{date}</span><br/><a href=\"$item->{dir}/\">$result</a></td>\n";
+			} else {
+				print "		<td class=\"cert\"></td>\n"
+			}
+		}
+		print "	</tr>\n";
+	}
+	print "</table>\n";
+}
+
+
+sub table($) {
+	my ($list) = @_;
+
+	table2(0, $list, \%components);
+}
+
+
+$list=`ls -1 | egrep '^(gridsite|lb|px|canl)'`;
+@list=split /\n/, $list;
+
+#$list{install} = ();
+#$list{upgrade} = ();
+foreach my $i (0..$#list) {
+	my ($plat, $scen, $date);
+
+	$item = $list[$i];
+	if (not $item=~/^([^\.]*)\.(.*)/) { next; }
+	@item=split /-/, $1;
+	if ($item[0] eq 'canl') {
+		shift @item;
+		$item[0] = "canl-$item[0]";
+	}
+	if ($#item != 2 or not $item[1] or not $item[2]) { next; }
+	$date = $2;
+	$date =~ s/(...)(..)(..)T(..)(..)/$1-$2-$3/;
+	
+	$scen = 'install';
+	if (-f "$item/scenario") {
+		open FH, '<', "$item/scenario" || die;
+		$_ = <FH>;
+		close FH;
+		chomp;
+		if (/perf/i) { $scen = $_; }
+		elsif (/upgrade/i) { $scen = 'upgrade'; }
+		elsif (/build/i) { $scen = 'build'; }
+	}
+	
+	$plat = "$item[1]-$item[2]";
+#printf STDERR "$date, $scen, $item[0], $plat\n";
+
+	$components{$item[0]} = 1;
+	$platforms{$plat} = 1;
+
+	if ($scen =~ /perf/i) {
+		$list{perf}{$scen}{$plat} = { 'component' => $item[0], 'platform' => $plat, 'dir' => $item, 'date' => $date };
+#printf STDERR "perf: $scen, $item[0], $plat\n";
+	} else {
+		$list{$scen}{$item[0]}{$plat} = { 'component' => $item[0], 'platform' => $plat, 'dir' => $item, 'date' => $date };
+	}
+}
+
+foreach my $s (keys %list) {
+	foreach my $c (keys %{$list{$s}}) {
+		my %ins_c=%{$list{$s}{$c}};
+		foreach my $p (keys %ins_c) {
+			$item=$ins_c{$p};
+
+#printf STDERR "$item->{component}, $item->{platform}\n";
+			undef $result;
+			if (-f "$item->{dir}/report.twiki") {
+				my ($section, $err, $yaim_used, $yaim_finished);
+				`grep -- 'TESTS END HERE' $item->{dir}/report.twiki >/dev/null 2>&1`;
+				$section=$?;
+				`grep -- 'Installed YAIM versions' $item->{dir}/report.twiki >/dev/null 2>&1`;
+				$yaim_used=$?;
+				`grep -- 'YAIM terminated succesfully' $item->{dir}/report.twiki >/dev/null 2>&1`;
+				$yaim_finished=$?;
+				`grep -- 'ERROR:' $item->{dir}/report.twiki >/dev/null 2>&1`;
+				$err=$?;
+#printf STDERR "  sec: $section, err: $err\n";
+				if ($section == 0 && ($yaim_used != 0 || $yaim_finished == 0)) {
+					$result=`grep -- '-TEST FAILED-' $item->{dir}/report.twiki 2>/dev/null| wc -l | sed 's/ *//g'`;
+					chomp $result;
+				} else {
+					if ($section == 0) { $result = 'Error'; }
+					else { $result = 'Failed'; }
+				}
+			} else { undef $result; }
+			$item->{result} = defined $result ? $result : '-';
+
+			undef $result;
+			if (-f "$item->{dir}/report.log") {
+#printf STDERR "hit! $item->{dir}\n";
+				open FH, '<', "$item->{dir}/report.log" || die;
+				while (($_ = <FH>)) {
+					chomp;
+					if (/^6\)\s*(.*)\[jobs\/day\]/) { $result = $1; last; }
+				}
+				close FH;
+				if ($result) {
+					$result =~ s/  */ /g;
+				}
+			}
+			$item->{result2} = defined $result ? $result : '-';
+
+#print STDERR "$item->{dir}: $item->{result}, $item->{result2}\n";
+		}
+	}
+}
+
+
+# ==== glue reports ====
+foreach my $c (sort keys %components) {
+	my $cmd;
+
+	for my $s ('install', 'upgrade') {
+		if (exists $list{$s}) {
+			for my $p (keys %{$list{$s}{$c}}) {
+				$item = $list{$s}{$c}{$p};
+				if (exists $item->{result} and $item->{result} eq "0") {
+					$cmd = "cat $item->{dir}/report.twiki >> /tmp/report-$c-$s.twiki.part";
+					`$cmd`;
+				}
+			}
+		}
+	}
+	`cat /tmp/report-$c-install.twiki.part /tmp/report-$c-upgrade.twiki.part > /tmp/report-$c.twiki 2>/dev/null`;
+	`rm -f /tmp/report-$c-*.twiki.part`;
+}
+
+
+# ==== matrix ====
+$n_platforms = 0;
+for my $i (keys %platforms) { $n_platforms++; }
+$width = " width:".(100/(1+$n_platforms))."%;";
+$now = strftime('%Y-%m-%d %H:%M', localtime());
+print qq(<?xml version="1.0" encoding="UTF-8"?>
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+   "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+
+<head>
+	<title>Reports by platform table</title>
+	<style type="text/css">
+		table.main {border:none;}
+		table.cert {border:1px solid black; border-collapse:collapse; text-align:center;}
+		th.cert, td.cert {border:1px solid black; text-align:center;}
+		.OK {border:1px solid black; text-align:center;background-color: #80FF80;}
+		.FAIL {border:1px solid black; text-align:center;background-color: #FF2020;}
+		.date {font-size:xx-small; color: #404040;}
+		.comment {font-size:small;margin:0px 0px 0px 0px;}
+		p.comment {margin:15px 0px 0px 0px;}
+		p.modified {margin:0px 0px 0px 0px;}
+		table.modified {border:0px none; width:100%;}
+		td.modified {border:0px none; float:right; text-align: right;}
+		td.reports {border: 0px none; float:left; text-align:left; white-space:nowrap;}
+	</style>
+</head>
+
+<body>
+
+<table class="modified">
+	<tr>
+		<td>
+			<table class="modified">
+				<tr>
+					<td class="reports">);
+foreach my $c (sort keys %components) {
+	print "<a href=\"report-$c.twiki\">report-$c.twiki</a> ";
+}
+print qq(</td>
+					<td class="modified">Modified: $now</td>
+				</tr>
+			</table>
+		</td>
+	</tr>
+	<tr>
+		<td>
+
+);
+
+if (exists $list{install}) {
+	print "<a name=\"install\"/><h1>Install</h1>\n";
+	table($list{install});
+	print "\n";
+	if (-f 'install.html.in') {
+		system 'cat install.html.in';
+	}
+}
+
+if (exists $list{upgrade}) {
+	print "<a name=\"upgrade\"/><h1>Upgrade</h1>\n";
+	table($list{upgrade});
+	print "\n";
+	if (-f 'upgrade.html.in') {
+		system 'cat upgrade.html.in';
+	}
+}
+
+if (exists $list{build}) {
+	print "<a name=\"build\"/><h1>Local build</h1>\n";
+	table($list{build});
+	print "\n";
+	if (-f 'build.html.in') {
+		system 'cat build.html.in';
+	}
+}
+
+if (exists $list{perf}) {
+	my @keys = keys %{$list{perf}};
+	my %keys;
+	map { $keys{$_} = 1; } @keys;
+
+	print "<a name=\"perf\"/><h1>L&amp;B performance tests</h1>\n";
+	table2(1, $list{perf}, \%keys);
+	print "\n";
+	if (-f 'perf.html.in') {
+		system 'cat perf.html.in';
+	}
+}
+
+print qq{		</td>
+	</tr>
+</table>
+
+</body>
+
+</html>
+};
+
-- 
1.8.2.3