First version of dashboard.

diff --git a/dashboard.pl b/dashboard.pl
new file mode 100755 (executable)
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>
+};
+