#!/usr/bin/env perl use warnings; use strict; use File::Spec::Functions; use File::Basename; use Cwd; my $dir = &cwd . "/results"; my $webdir = $ENV{SRCDIR} . "/doc/website"; my $journal = catfile( $dir, "journal" ); my $list = catfile( $dir, "list" ); my $out = catfile( $dir, "html" ); my @flavours; my @tests; my %seenFlavours; my %seenTests; my %results; my %rescount; open( my $listhandle, "<", $journal ); while ( <$listhandle> ) { chomp; m/^([^:]*):([^\s]*)\s+(.*)$/; my ( $fl, $test, $status ) = ( $1, $2, $3 ); my $id = "$fl:$test"; unless ( exists $seenFlavours{ $fl } ) { $seenFlavours{ $fl } = 1; push( @flavours, $fl ); } unless ( exists $seenTests{ $test } ) { $seenTests{ $test } = 1; push( @tests, $test ); } $rescount{ $status } = 0 unless ( exists $rescount{ $status } ); $rescount{ $status }++; $results{ $id } = $status; } close( $listhandle ); delete $rescount{ started }; mkdir( $out ); my $builddate = "unknown"; my $buildtype = "unknown"; my $divine = "unknown"; my $divineExec = catfile( $dir, "..", "..", "tools", "divine" ); if ( -x $divineExec ) { open( my $dv, "$divineExec --version 2>/dev/null |" ); while ( <$dv> ) { chomp; if ( /^version: +(.*)$/ ) { $divine = $1; } if ( /^build date: +(.*)/ ) { $builddate = $1; } if ( /^build type: +(.*)/ ) { $buildtype = $1; } } } sub doIndex { my ( $name, $printer ) = @_; open( my $index, ">", catfile( $out, "$name.md" ) ); my $summary = ""; for my $k ( sort keys %rescount ) { $summary .= "$rescount{ $k } $k, "; } $summary =~ s/, $//; print $index < EOF ; if ( @flavours > 1 ) { print $index ""; for my $f ( @flavours ) { print $index "$f"; } print $index "\n"; } $printer->( $index ); print $index "\n"; close( $index ); system( "pandoc", "--to=html", "-s", "--smart", "--template", catfile( $webdir, "template.html" ), catfile( $out, "$name.md" ), "-o", catfile( $out, "$name.html" ) ); $/ = undef; open( my $ii, "<", catfile( $out, "$name.html" ) ); my $indexcont = <$ii>; close( $ii ); sub procLink { my ( $pre, $href, $post ) = @_; if ( ( $href =~ /^http/ ) || ( $href =~ m|^\./| ) || ( $href =~ m|^/| ) ) { $href =~ s|^\./|| if ( $href =~ m|^\./| ); return "$pre$href$post"; } else { return "$pre//$href$post"; } } $indexcont =~ s/([<]a[^>]*href=["'])([^"']*)(['"])/procLink( $1, $2, $3 )/gems; open( my $oi, ">", catfile( $out, "$name.html" ) ); print $oi $indexcont; close( $oi ); } doIndex( "full", sub { my ( $index ) = @_; for my $t ( @tests ) { print $index "$t"; for my $f ( @flavours ) { my $id = "$f:$t"; my $report = "${f}_${t}.txt"; $report =~ s|/|_|g; my $origreport = "$id.txt"; $origreport =~ s|/|_|g; my $res = $results{ $id }; $res = "none" unless $res; print $index "[$res](./$report)"; system( "cp", catfile( $dir, $origreport ), catfile( $out, $report ) ); } print $index "\n"; } } ); my %codemap = ( passed => "✓", failed => "✗", warning => "!", skipped => "–", started => "…", timeout => "T", none => " " ); doIndex( "compact", sub { my ( $compact ) = @_; my %agreg; for my $t ( @tests ) { for my $f ( @flavours ) { my $id = "$f:$t"; my $report = "${f}_${t}.txt"; $report =~ s|/|_|g; my $aid = dirname( ${t} ); $aid = (split( "/", $aid ))[0]; my $res = $results{ $id }; $res = "none" unless $res; my $r = $res; $r = $codemap{ $res } if exists $codemap{ $res }; $agreg{ $aid }->{ $f } = "" unless exists $agreg{ $aid }->{ $f }; $agreg{ $aid }->{ $f } .= "$r"; } } for my $t ( sort( keys %agreg ) ) { print $compact "$t"; for my $f ( @flavours ) { print $compact ( "" . $agreg{ $t }->{ $f } . "" ); } print $compact "\n"; } } ); system( "cp", catfile( $webdir, "style.css" ), catfile( $out, "style.css" ) ); print STDERR "file://" . catfile( $out, "full.html" ) . "\n"; print STDERR "file://" . catfile( $out, "compact.html" ) . "\n";