[masstest] Use a new template, improve this and that

tadzik · Apr 26, 2012 · e815355 · e815355
1 parent dccd200
commit e815355
Showing 1 changed file with 121 additions and 45 deletions.
diff --git a/bin/masstest b/bin/masstest
@@ -2,72 +2,145 @@
 use Panda;
 use Shell::Command;
 
+#run with PERL6LIB=ext:lib:$PWD/installlib/lib perl6 bin/masstest
+
 my $tmpl-main = '
-<?xml version="1.0" encoding="UTF-8"?>
-<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
-  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
+<!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" xml:lang="en" lang="en">
 <head>
     <title>Emmentaler</title>
-     <meta name="description" content="Home page for Perl 6, the next major version of the Perl programming language" />
-    <link rel="icon" href="/favicon.ico" type="favicon.ico" />
+    <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />
     <style type="text/css">
-        @import url("style.css");
+        .implemented, .implemented a {
+            background-color: #3c3;
+            color:            white;
+        }
+        .partial    , .partial a     {
+            background-color: #fb4;
+            color:            #333;
+        }
+        .missing    , .missing a     {
+            background-color: #f55;
+            color:            white;
+        }
+        .unknown    , .unknown a      {
+            background-color: #ccc;
+            color:            white;
+        }
+        .implemented, .partial, .missing, .unknown {
+            text-align:         center;
+            width:              150px;
+            font-weight:        bold;
+            font-family:        monospace;
+            font-size:          18px;
+            -moz-border-radius: 15px;
+            border-radius:      15px;
+        }
+        .subsection {
+            padding-top: 1em;
+            text-align: left;
+        }
+        .minor {
+            font-size:  smaller;
+            font-style: italic;
+        }
+        .footnote_link { 
+            font-size: 70%%;
+            position:  absolute; 
+        }
+        :target {
+            background-color: #FFFF66;
+        }
     </style>
+
 </head>
 <body>
-<div id="wrapper-outer">
+    <img src="http://perl6.org/camelia-logo-small.png" alt="Camelia, the Perl 6 bug" align="right">
+
+    <h1>Emmentaler</h1>
+
+    <h2>Modules (on Rakudo)</h2>
+    <table>
+        <thead>
+            <tr>
+                <th>Module</th>
 
-<div id="header">
-    <img src="camelia-logo.png" alt="camelia perl bug logo" />
-    <h2>Welcome to Emmentaller</h2>
-    <p>Hi, my name is tadzik and I stole this layout. LOL!</p>
-</div>
+                <th>Prereqs ok</th>
+
+                <th>Builds</th>
+
+                <th>Tests</th>
+
+                <th>Additional information</th>
+            </tr>
+        </thead>
+        <tbody>
 
 %s
 
-</div> <!-- id="wrapper-outer" -->
+         </tbody>
+    </table>
+
 </body>
 </html>
 ';
 
-my $tmpl-project-ok = '
-    <div id="community" class="box">
-        <h4>%s</h4>
-        Everything\'s fine \o/
-    </div>
+my $tmpl-project = '
+<tr><td style="border-bottom:1px dotted #98CAEB"><a href="%s">%s</a></td>
+<td><div class="%s">%s</div></td>
+<td><div class="%s">%s</div></td>
+<td><div class="%s">%s</div></td>
+<td>%s</td>
+</tr>
 ';
 
-my $tmpl-project-fail = '
-    <div id="specs" class="box">
-        <h4>%s</h4>
-        <p><b>%s stage has failed</b></p>
-        <p>%s</p>
-    </div>
-';
+sub good    { 'implemented', '+' }
+sub bad     { 'missing',     '-' }
+sub unknown { 'unknown',     '?' }
 
+sub url(Pies::Project $p) {
+    if $p.metainfo<source-url> ne "" {
+        $p.metainfo<source-url>.subst(/^git/, 'http').subst(/\.git$/, '')
+    } else {
+        ''
+    }
+}
 
-multi gen-result(Str $m, True) {
-    sprintf $tmpl-project-ok, $m
+multi gen-result(Pies::Project $p, True) {
+    sprintf $tmpl-project, url($p), $p.name, good(), good(), good(), ""
 }
 
-multi gen-result(Str $m, X::Panda $ex) {
-    my $desc  = $ex.description;
-    my $stage = $ex.stage;
-    if $m ne $ex.module {
-        $desc = "Building dependency {$ex.module} has failed";
-        $stage = 'resolve';
+multi gen-result(Pies::Project $p, X::Panda $ex) {
+    my (@pre, @build, @test);
+
+    given $ex.stage {
+        when 'resolve' | 'fetch' {
+            @pre  = bad();
+            @build = @test = unknown();
+        }
+        when 'build' {
+            @pre   = good();
+            @build = bad();
+            @test  = unknown();
+        }
+        when 'test' {
+            @pre  = @build = good();
+            @test = bad();
+        }
     }
 
-    sprintf $tmpl-project-fail, $m, $ex.stage, $desc
+    my @args = (url($p), $p.name, @pre, @build, @test, $ex.description).flat;
+
+    sprintf $tmpl-project, |@args;
 }
 
 sub MAIN ($projectsdir = "projects.json.small") {
     try mkdir "installlib";
     my $panda = Panda.new(
         srcdir       => "masstest/pandadir/src",
-        destdir      => "installlib",
+        destdir      => "{cwd}/installlib",
         statefile    => "masstest/pandadir/state",
         projectsfile => $projectsdir,
     );
@@ -76,23 +149,26 @@ sub MAIN ($projectsdir = "projects.json.small") {
 
     for $panda.ecosystem.project-list -> $p {
         my $x = $panda.ecosystem.get-project($p);
-        if $panda.ecosystem.project-get-state($x) eq 'absent' {
-            try $panda.resolve($p);
-            if defined $! {
-                %log{$p} = $!;
-            } else {
-                %log{$p} = True;
-            }
+        # don't waste time if it has already been installed once
+        if $panda.ecosystem.project-get-state($x) ne 'absent'
+        or $p eq "panda" {
+            %log{$p} = True;
+            next;
+        }
+        try $panda.resolve($p);
+        if defined $! {
+            %log{$p} = $!;
+        } else {
+            %log{$p} = True;
         }
     }
 
     shell 'rm -rf masstest';
     shell 'rm -rf installlib/*';
 
     my $contents;
-    for %log.keys.sort -> $m {
-        say %log{$m}.perl;
-        $contents ~= gen-result($m, %log{$m});
+    for %log.keys.sort(*.lc) -> $m {
+        $contents ~= gen-result($panda.ecosystem.get-project($m), %log{$m});
     }
 
     my $html = open('index.html', :w);