work on pointing error messages to source files
[pspp] / results2html
index abc520d3db5033cad7701e7725f29a09c7113adf..4bf398d35c49b9734d92578e3abdc4a6c71f37d2 100755 (executable)
@@ -3,6 +3,7 @@
 use strict;
 use warnings;
 
+use File::Spec;
 use HTML::Entities;
 
 open (LOG, '<', "LOG");
@@ -36,16 +37,24 @@ my (@products);
 my (@steps);
 my ($new_page) = 0;
 my ($result) = "failure";
+my @dirstack;
 while (<LOG>) {
     my $ln = $.;
     chomp;
 
     if (/^\f$/) {
        $new_page = 1;
+       @dirstack = ();
        print LOG_HTML "</pre><hr><pre>\n";
        next;
     }
 
+    if (/Entering directory `(.*)'$/) {
+        push (@dirstack, $1);
+    } elsif (/Leaving directory `(.*)'$/) {
+        pop (@dirstack);
+    }
+
     my $log_class;
     if ($new_page) {
        $new_page = 0;
@@ -74,6 +83,21 @@ while (<LOG>) {
            $d{DIAGNOSTIC} = lc ($diagnostic);
            $d{MESSAGE} = $_;
            $d{LN} = $ln;
+
+           if (@dirstack && (my ($file, $line) = /^([^\s:]+):(\d+):\s/)) {
+               $file = File::Spec->rel2abs ($file, $dirstack[$#dirstack]);
+               my (@path) = grep ($_ ne '' && $_ ne '.', split ('/', $file));
+               for (my $i = 0; $i < $#path; ) {
+                   if ($path[$i + 1] eq '..') {
+                       splice (@path, $i, 2);
+                   } else {
+                       $i++;
+                   }
+               }
+
+               $d{LINE} = $line;
+               $d{FILE} = join ('/', @path);
+           }
            push (@{$steps[$#steps]{CHILDREN}}, \%d);
 
            $log_class = "$diagnostic";
@@ -136,7 +160,11 @@ foreach my $s (@steps) {
            print INDEX "<p class=\"$c->{DIAGNOSTIC}\">";
            print INDEX "<a href=\"log.html#$c->{LN}\">";
            print INDEX encode_entities ($c->{MESSAGE});
-           print INDEX "</a></p>\n";
+           print INDEX "</a>";
+           if (exists $c->{FILE}) {
+               print INDEX " in $c->{FILE}";
+           }
+           print INDEX "</p>\n";
        } else {
            print INDEX "<p>&rarr; <a href=\"", encode_entities ($c->{HREF}), "\">";
            print INDEX encode_entities ($c->{PRODUCT});