From 3cd3376139d6689b93ca93b24f22257e7db8a83c Mon Sep 17 00:00:00 2001
From: David Brown <dave@brownsmeet.com>
Date: Thu, 30 Jun 2016 19:41:14 +0100
Subject: [PATCH] Test build progress

---
 src/tools/testcoordinator/buildall.pl | 34 ++++++++++++-
 src/tools/testcoordinator/postpush.pl |  9 ++--
 src/tools/testcoordinator/pt.pl       | 70 +++++++++++++++++++++++++++
 3 files changed, 107 insertions(+), 6 deletions(-)
 create mode 100755 src/tools/testcoordinator/pt.pl

diff --git a/src/tools/testcoordinator/buildall.pl b/src/tools/testcoordinator/buildall.pl
index bbc77e8b..49b90800 100755
--- a/src/tools/testcoordinator/buildall.pl
+++ b/src/tools/testcoordinator/buildall.pl
@@ -50,5 +50,35 @@ for my $machine (sort keys %machines) {
 }
 
 while ((my $pid = wait) > 0) {print "Child pid $pid completed.\n";}
-print "Buildall complete.\n";
-exit;
+
+
+# # All builds have completed. Now scan the logs for pass/fail and build the passing report.
+# 
+# my %status = ();
+# open(my $logs, "/tmp/buildall.log") // die "Couldn't open combined build log.";
+# while (<$logs>) {
+#   if (/^([^ ]+) ([^ ]+) --- Branch ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) confidence tests passed ---/) {
+#     $status{$1} = [$2, $3, $4, $5, $6];
+#   }
+# }
+# close(my $logs);
+# 
+# 
+# sub svgtext {
+#   my ($f, $x, $y, $msg) = @_;
+#   print($f "<text x=\"$x\" y=\"$y\" font-family=\"Verdana\" font-size=\"18\" font-fill=\"black\">";
+#   print($f $msg);
+#   print($f "</text>\n");
+# }
+# 
+# 
+# open(my $svg, ">passing.svg") // dir "Could not create passing.svg.");
+# print $svg '<svg width="10cm" height="3cm" viewBox="0 0 1000 300" xmlns="http://www.w3.org/2000/svg" version="1.1">\n';
+# 
+# my $i=1;
+# for my $host (sort keys %status) {
+#   svgtext($svg, 10, $i*20, $host);
+#   $i++;
+# }
+# 
+# print $svg '</svg>\n';
diff --git a/src/tools/testcoordinator/postpush.pl b/src/tools/testcoordinator/postpush.pl
index 25bb2a89..4db1e46b 100755
--- a/src/tools/testcoordinator/postpush.pl
+++ b/src/tools/testcoordinator/postpush.pl
@@ -11,7 +11,7 @@ use JSON;
 
 sub writelog {
   my ($msg) = @_;
-
+  
   open(LOG, ">>/tmp/postpush.log") or die "Could not create postpush.log";
   flock(LOG, 2)                    or die "Could not lock postpush.log";
   print LOG sprintf("%s %s\n", strftime("%Y/%m/%d %H.%M.%S", localtime), $msg);
@@ -36,12 +36,13 @@ my $child = fork;
 if (not defined $child) {die "Fork failed.";}
 if ($child) {
   # parent process
-  writelog "Started ssh, pid = $child.";
+  writelog "Started buildall, pid = $child.";
 } else {
   # child process
-  exec 'ssh root@oberon "perl vishap/voc/src/tools/testcoordinator/buildall.pl >/tmp/buildall.log &"';
+  close(STDIN); close(STDOUT); close(STDERR);
+  exec 'perl /var/lib/nethserver/ibay/githubhook/buildall.pl >/tmp/buildall.log';
   exit;
-}
+}                                                                     
 
 print header(),
   start_html("Vishap Oberon github post push web hook."),
diff --git a/src/tools/testcoordinator/pt.pl b/src/tools/testcoordinator/pt.pl
new file mode 100755
index 00000000..a39618d4
--- /dev/null
+++ b/src/tools/testcoordinator/pt.pl
@@ -0,0 +1,70 @@
+#!perl -w
+use strict;
+use warnings;
+use POSIX "strftime";
+
+
+
+my %status = ();
+open(my $logs, "/tmp/buildall.log") // die "Couldn't open combined build log.";
+while (<$logs>) {
+  if (/^([^ ]+) ([^ ]+) --- Branch ([^ ]+) ([^ ]+) ([^ ]+) ([^ ]+) confidence tests passed ---/) {
+    my $key = "$4-$6-$5";
+    $status{$key} = [$1, $2, $3, $4, $5, $6];
+  }
+}
+close($logs);
+
+my $emsperline = 1.2;
+
+sub svgtext {
+  my ($f, $x, $y, $colour, $msg) = @_;
+  print $f '<text x="', $x;
+  print $f '" y="', ($y+1)*$emsperline + 0.3;
+  print $f 'em" font-family="Verdana" font-size="1em" fill="';
+  print $f $colour;
+  print $f '">';
+  print $f $msg;
+  print $f "</text>\n";
+}
+
+my $rows = keys %status;
+
+open(my $svg, ">build-status.svg") // die "Could not create build-status.svg.";
+print $svg '<svg width="680" height="';
+print $svg ($rows+2) * $emsperline;
+print $svg 'em" xmlns="http://www.w3.org/2000/svg" version="1.1">', "\n";
+print $svg '<rect width="100%" height="100%" rx="20" ry="20" fill="#404040"/>', "\n";
+
+my $col1 = 20;
+my $col2 = 110;
+my $col3 = 200;
+my $col4 = 310;
+my $col5 = 400;
+my $col6 = 490;
+my $col7 = 580;
+
+svgtext($svg, $col1, 0, "#e0e0e0", "OS");
+svgtext($svg, $col2, 0, "#e0e0e0", "Compiler");
+svgtext($svg, $col3, 0, "#e0e0e0", "Data model");
+svgtext($svg, $col4, 0, "#e0e0e0", "Compiler");
+svgtext($svg, $col5, 0, "#e0e0e0", "Library");
+svgtext($svg, $col6, 0, "#e0e0e0", "Cksum");
+svgtext($svg, $col7, 0, "#e0e0e0", "Tests");
+
+my $i=1;
+for my $key (sort keys %status) {
+  my ($host, $time, $branch, $os, $compiler, $datamodel) = @{$status{$key}};
+  svgtext($svg, $col1, $i, "#c0c0c0", $os);
+  svgtext($svg, $col2, $i, "#c0c0c0", $compiler);
+  svgtext($svg, $col3, $i, "#c0c0c0", $datamodel);
+  svgtext($svg, $col4, $i, "#60ff60", "Pass");
+  svgtext($svg, $col5, $i, "#60ff60", "Pass");
+# svgtext($svg, $col6, $i, "#60ff60", "Pass");
+  svgtext($svg, $col7, $i, "#60ff60", "Pass");
+  $i++;
+}
+
+print $svg "</svg>\n";
+
+system 'scp -p build-status.svg dave@hub:/var/www';