Re: [PATCH OSSTEST v2 5/5] ms-flights-summary: Produce an HTML report of all active flights

[Ian Campbell <ian.campbell@citrix.com>]

On Tue, 2015-07-14 at 14:58 +0100, Ian Campbell wrote:
> This could surely use better Perl and produce better output, however
> I'm sending it now because it would be useful for further development
> if some or all of the preceding patches could go into production and
> this serves as an example of why I think I want them.

This was even more WIP than I meant to send out, sorry.

Here is a v3 of just this one patch which is a bit less so...

----8<-----

>From b72688c114cfd0ba55b547e0634965d4c744dfc9 Mon Sep 17 00:00:00 2001
From: Ian Campbell <ian.campbell@citrix.com>
Date: Tue, 14 Jul 2015 15:32:54 +0100
Subject: [PATCH] ms-flights-summary: Produce an HTML report of all active
 flights

Jobs are categorised by a new ->Job field. This is added by
ts-hosts-alllocate-Executive and propagated byu the planner after
recent patches. It contains $flight.$job.

Jobs which do not include this are anonymous and are listed
separately.

Jobs which the plan describes as "(preparing)" (which I think means they
are waiting for another job to regroove build host for sharing) are
currently classified as anonymous until they are done preparing, at
which point they become correctly classified again. I can't see how
to figure out the correct ->{Job} at this point in the planner.

TODO: Hook up to cron (via for-maintjobs.git) or otherwise arrange for
this to be run when the plan is updated.

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
---
Example output:
http://xenbits.xen.org/people/ianc/tmp/fsummary-v3.html

This could surely use better Perl and produce better output, however
I'm sending it now because it would be useful for further development
if some or all of the preceding patches could go into production and
this serves as an example of why I think I want them.

v3:
  - Author/S-o-b using correct hat.
  - Much improved output, somewhat improved code (v2 was a bit more
    WIP even than I had intended to send out).
  - perl -w
v2:
  - Get the plan from the queue daemon.
  - Do not parse ->Info, instead expect a new ->Job field
  - Handle multiple resources for a job.

nicer output

wip
---
 ms-flights-summary | 309 +++++++++++++++++++++++++++++++++++++++++++++++++++++
 ms-planner         |   1 +
 2 files changed, 310 insertions(+)
 create mode 100755 ms-flights-summary

diff --git a/ms-flights-summary b/ms-flights-summary
new file mode 100755
index 0000000..651d13d
--- /dev/null
+++ b/ms-flights-summary
@@ -0,0 +1,309 @@
+#!/usr/bin/perl -w
+
+use strict qw(vars refs);
+
+use Osstest;
+use Osstest::Executive qw(:DEFAULT :colours);
+
+use JSON;
+use POSIX;
+use Data::Dumper;
+use HTML::Entities;
+
+# $flights{NNNN} = {
+#     Nr => NNNN,
+#     Stats => {
+#         Pass => <NRPASS>,
+#         Fail => <NRFAIL>,
+#         ...
+#     },
+#     Started => ...,
+#     Blessing => ...,
+#     Branch => ...,
+#     Intended => ...,
+#     ExpectedEnd => ...,
+#     Jobs => {
+#         JNAME1 => {
+#             Reso => {
+#                 RNAME1 => {
+#                     Start => ...,
+#                     End => ...,
+#                 },
+#                 RNAME2 => { ... },
+#             },
+#             OverallTime => { Start => ..., End => ... },
+#             Receipe => ...,
+#             Status => pass|fail|...,
+#         },
+#         JNAME2 => { ... },
+#     },
+# };
+our %flights;
+
+# As for $flights{NNN}{Jobs} but each Job only has the Reso and
+# OverallTime keys
+our %anon_jobs;
+
+our $plan;
+
+sub get_current_plan () {
+    my $qserv = tcpconnect_queuedaemon();
+    my $jplan = get_plan($qserv);
+    $plan= from_json($jplan);
+    #print STDERR Dumper($plan);
+}
+
+# Find all the flights referenced by an Event and insert into %flights.
+sub enumerate_flights() {
+    while (my ($reso,$evts) = each %{ $plan->{Events} }) {
+	foreach my $evt ( @{$evts} ) {
+	    next unless $evt->{Type} =~ m/^(Start|End)$/;
+	    next unless $evt->{Job};
+	    $evt->{Job} =~ m/^([0-9]+)\.(.*)/ or die;
+
+	    my $f = $1;
+
+	    next if $flights{$f};
+
+	    my $flightinfo= $dbh_tests->selectrow_hashref(<<END);
+	    SELECT started,blessing,branch,intended FROM flights
+		WHERE flight=$f
+END
+            $flights{$f}= { Nr => $f,
+			    Stats => {},
+	                    Jobs => {} };
+            foreach my $fld (qw(started blessing branch intended)) {
+                $flights{$f}->{ucfirst($fld)}= $flightinfo->{$fld};
+	    };
+	    $flights{$f}->{ExpectedEnd} = 0;
+	}
+    }
+}
+
+# Enumerate all jobs of every known flight and populate the
+# corresponding ->{Jobs}.
+sub enumerate_jobs($) {
+    my ($f) = @_;
+
+    $f->{Jobs} = {};
+
+    my $jobs= $dbh_tests->selectall_arrayref(<<END, { Slice => {} });
+        SELECT job,recipe,status FROM jobs
+            WHERE flight=$f->{Nr}
+END
+
+    for my $row (@{$jobs}) {
+	$f->{Jobs}{$row->{job}} =
+	{
+	    Status => $row->{status},
+	    Recipe => $row->{recipe},
+	    Reso => {},
+	};
+    }
+}
+
+# Gather statistics around number of pass/fail/etc jobs in each
+# flight.
+sub gather_stats($) {
+    my ($f) = @_;
+
+    my $stats= $dbh_tests->selectall_arrayref(<<END);
+        SELECT status,COUNT(*) FROM jobs
+	    WHERE flight=$f->{Nr}
+            GROUP BY status
+END
+    for my $row (@{$stats}) {
+	my ($stat,$count) = @$row;
+	$f->{Stats}{ucfirst($stat)} = $count;
+    }
+}
+
+sub add_event($$$$) {
+    my ($job,$reso,$type,$time) = @_;
+
+    die unless $type =~ m/^(Start|End)/;
+
+    $job->{OverallTime} //= {};
+
+    $job->{Reso}{$reso} //= {};
+    $job->{Reso}{$reso}{$type} = $time;
+
+    my $cmp = $type eq "Start" ?
+	sub { $_[0] < $_[1] ? $_[0] : $_[1] } :
+	sub { $_[0] > $_[1] ? $_[0] : $_[1] };
+
+    $job->{OverallTime}{$type} //= $time;
+
+    $job->{OverallTime}{$type} =
+	$cmp->($time, $job->{OverallTime}{$type});
+}
+
+# Walk all events in the plan and update the corresponding flight/job
+# with the timespan. Events relating to unknown jobs are added to
+# %anon_jobs.
+sub gather_events() {
+    while (my ($reso,$evts) = each %{ $plan->{Events} }) {
+	foreach my $evt ( @{$evts} ) {
+	    my ($f,$job);
+	    next unless $evt->{Type} =~ m/^(Start|End)$/;
+	    if ( $evt->{Job} ) {
+		my ($fnum,$j);
+		$evt->{Job} =~ m/^([0-9]+)\.(.*)/ or die;
+		($fnum,$j) = ($1,$2);
+		goto anon unless $flights{$fnum};
+		$f = $flights{$fnum};
+		goto anon unless $f->{Jobs}{$j};
+		$job = $f->{Jobs}{$j};
+	    } else {
+ anon:
+		# The JSON version of the plan does not include
+		# $evt->{Info}, the best we have got is the resource
+		# itself.
+		$anon_jobs{$reso} //= { Reso => {} };
+		$job = $anon_jobs{$reso}
+	    }
+
+	    my $time = $plan->{Start} + $evt->{Time};
+
+	    add_event($job, $reso, $evt->{Type}, $time);
+
+	    if ($f && $evt->{Type} eq "End") {
+		$f->{ExpectedEnd} =
+		    $time > $f->{ExpectedEnd} ?
+		    $time : $f->{ExpectedEnd};
+	    }
+	}
+    }
+}
+
+###########
+
+csreadconfig();
+
+get_current_plan();
+
+enumerate_flights();
+
+foreach my $f (keys %flights) {
+    enumerate_jobs($flights{$f});
+    gather_stats($flights{$f});
+}
+
+gather_events();
+
+############
+
+my @cols = ("Job", "Status", "Resource", "Scheduled");
+
+sub fmttime($)
+{
+    my ($t) = @_;
+    return "Unknown" if !$t;
+    return strftime("%Y-%b-%d %a %H:%M:%S", gmtime $t);
+}
+
+sub fmt_timespan($) {
+    my ($s) = @_;
+
+    return undef unless $s;
+
+    if ( $s->{Start} || $s->{End} ) {
+	return join(" &mdash; ",
+		    map { encode_entities(fmttime($s->{$_})) }
+		    qw(Start End));
+    } else {
+	return "???";
+    }
+}
+
+sub cols_hdr() {
+    printf("<tr bgcolor=#808080>\n");
+    printf(" <th align='left'>%s</th>\n", encode_entities($_)) foreach @cols;
+    printf("</tr>\n");
+}
+
+sub flight_hdr($) {
+    my $text = encode_entities(shift);
+    printf("    <tr><td colspan=%d><b>$text</b></td></tr>\n", scalar @cols);
+}
+
+sub cell($;$$) {
+    my ($text,$bgcolour,$tag) = @_;
+    $text //= '';
+    $bgcolour = $bgcolour ? "bgcolor=$bgcolour" : '';
+    $text = "<$tag>$text</$tag>" if $tag;
+    printf(" <td valign=top $bgcolour>$text</td>\n");
+}
+
+sub do_one_job($$$) {
+    my ($alt,$job,$info) = @_;
+    my $status = $info->{Status} // "???";
+
+    my %bgcolours = (
+	pass => $green,
+	fail => $red,
+    );
+    my $bgcolour = report_altcolour(${$alt});
+
+    my @resos = sort keys %{ $info->{Reso} };
+
+    my ($resos,$spans);
+    my $resopfx = '';
+    if (@resos > 1) {
+	$resos = "Overall<br>\n    ";
+	$resopfx = "&mdash; ";
+	$spans = fmt_timespan($info->{OverallTime})."<br>\n    ";
+    }
+
+    $resos .= join "<br>\n    ", map { "$resopfx$_" } @resos;
+    $spans .= join "<br>\n    ", map { fmt_timespan($info->{Reso}{$_}) } @resos;
+
+    print "<tr $bgcolour>\n";
+
+    my $tag = $status eq "running" ? "b" : undef;
+
+    cell(encode_entities($job), undef, $tag);
+    cell(encode_entities($status), $bgcolours{$status}, $tag);
+    cell($resos);
+    cell($spans);
+
+    print "</tr>\n";
+    ${$alt} ^= 1;
+}
+
+printf("<p>Based on plan at ".fmttime($plan->{Start})."</p>\n");
+
+printf("<table border='0' cellspacing='0' rules=all>\n");
+
+foreach my $f (sort keys %flights) {
+    my $fi = $flights{$f};
+    my $alt = 0;
+
+    printf ("<tr><td colspan=%d>\n  <table>\n", scalar @cols);
+    print ("    <tr><td>&nbsp;</td></tr>\n");
+    flight_hdr("Flight: $f [$fi->{Branch} $fi->{Intended}]");
+    flight_hdr("Started: ".fmttime($fi->{Started}));
+    flight_hdr("Expected end: ".fmttime($fi->{ExpectedEnd}));
+    flight_hdr(
+	join("; ", map { "$_: $fi->{Stats}{$_}" } (sort keys %{$fi->{Stats}}))
+	);
+    print ("  </table>\n</td></tr>\n");
+
+    cols_hdr();
+
+    do_one_job(\$alt,$_, $fi->{Jobs}{$_})
+	foreach sort { $a cmp $b } keys %{$fi->{Jobs}};
+}
+print "\n";
+
+printf ("<tr><td colspan=%d>\n  <table>\n", scalar @cols);
+print ("   <tr><td>&nbsp;</td></tr>\n");
+flight_hdr("Anonymous Jobs");
+print ("  </table>\n</td></tr>\n");
+cols_hdr();
+my $alt = 0;
+foreach my $j (sort keys %anon_jobs) {
+    do_one_job(\$alt,$j, $anon_jobs{$j});
+}
+
+print "</table>\n";
diff --git a/ms-planner b/ms-planner
index f38f05b..35d430b 100755
--- a/ms-planner
+++ b/ms-planner
@@ -289,6 +289,7 @@ END
 	    $info= "rogue task $arow->{subtask}";
 	}
 	$plan->{Allocations}{$reskey}= {
+	    # Can we find a Job here?
             Task => $arow->{owntaskid},
 	    Info => $info,
 	    Start => $plan->{Start},
-- 
2.1.4