X-Git-Url: https://pintos-os.org/cgi-bin/gitweb.cgi?p=pspp;a=blobdiff_plain;f=results2html;h=b330c871abbdae8a74df08a6fa36cb5d52eb6c3b;hp=4bf398d35c49b9734d92578e3abdc4a6c71f37d2;hb=HEAD;hpb=ec687b924f4a605bc8c2bc441105f47757a7c6cf diff --git a/results2html b/results2html index 4bf398d35c..b330c871ab 100755 --- a/results2html +++ b/results2html @@ -3,8 +3,16 @@ use strict; use warnings; +use Digest::SHA; use File::Spec; -use HTML::Entities; +use HTML::Entities qw(); +use URI::Escape; + +sub encode_entities { + return HTML::Entities::encode_entities($_[0], "<&>'\""); +} + +my $gitweb_url = 'http://benpfaff.org/cgi-bin/gitweb.cgi?p=pspp;a=blob;f=[FILE];hb=[BRANCH]#l[LINE]'; open (LOG, '<', "LOG"); open (LOG_HTML, '>', "log.html"); @@ -12,6 +20,7 @@ open (LOG_HTML, '>', "log.html"); print LOG_HTML < + @@ -37,6 +46,8 @@ my (@products); my (@steps); my ($new_page) = 0; my ($result) = "failure"; +my (%dist_files); +my ($dist_dir); my @dirstack; while () { my $ln = $.; @@ -59,7 +70,7 @@ while () { if ($new_page) { $new_page = 0; $log_class = "step"; - if (my ($name, $product) = /^Saving(?:([^:]*):)?\s+(.*)$/) { + if (my ($name, $product) = /^Saving(?:\s+([^:]*):)?\s+(.*)$/) { my $href = "$product/index.html"; $href = $product if ! -e $href; @@ -69,7 +80,20 @@ while () { $p{HREF} = $href; $p{LN} = $ln; push (@products, \%p); - push (@{$steps[$#steps]{CHILDREN}}, \%p); + push (@{$steps[$#steps]{CHILDREN}}, \%p) if @steps; + + if (defined ($name) && $name eq 'source distribution') { + open (DIST, '-|', "zcat $product | tar tf -"); + while (my $line = ) { + chomp $line; + $line =~ s%^([./])*%%; # Trim leading ./ + $dist_files{$line} = 1; + if (!defined ($dist_dir)) { + $dist_dir = (split ('/', $line))[0]; + } + } + close (DIST); + } } else { my (%s); $s{TITLE} = $_; @@ -84,19 +108,30 @@ while () { $d{MESSAGE} = $_; $d{LN} = $ln; - if (@dirstack && (my ($file, $line) = /^([^\s:]+):(\d+):\s/)) { + if (@dirstack && defined ($dist_dir) + && (my ($match, $file, $line) = /^(([^\s:]+):(\d+):)/)) { $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); + for (my $i = 1; $i <= $#path; ) { + if ($path[$i] eq '..') { + splice (@path, $i - 1, 2); + $i-- if $i > 1; } else { $i++; } } - $d{LINE} = $line; - $d{FILE} = join ('/', @path); + for (my $i = $#path; $i >= 0; $i--) { + if ($path[$i] eq $dist_dir) { + my $dist_file = join ('/', @path[$i..$#path]); + if (exists ($dist_files{$dist_file})) { + $d{MATCH} = length ($match); + $d{LINE} = $line; + $d{FILE} = $dist_file; + } + last; + } + } } push (@{$steps[$#steps]{CHILDREN}}, \%d); @@ -116,6 +151,7 @@ open (INDEX, '>','index.html'); print INDEX < + @@ -141,7 +177,17 @@ foreach my $p (@products) { print INDEX encode_entities ($p->{NAME}), ": " if defined ($p->{NAME}); print INDEX "{HREF}), "\">"; print INDEX encode_entities ($p->{PRODUCT}); - print INDEX "\n"; + print INDEX "\n"; + if ($p->{PRODUCT} =~ /\.tar\.gz$/) { + my $sha = Digest::SHA->new(1); + $sha->addfile($p->{PRODUCT}); + print INDEX "
sha1: ", $sha->hexdigest, "\n"; + + $sha = Digest::SHA->new(256); + $sha->addfile($p->{PRODUCT}); + print INDEX "
sha256: ", $sha->hexdigest, "\n"; + } + print INDEX "\n"; } print INDEX "\n"; @@ -158,12 +204,22 @@ foreach my $s (@steps) { foreach my $c (@{$s->{CHILDREN}}) { if (defined ($c->{DIAGNOSTIC})) { print INDEX "

{DIAGNOSTIC}\">"; - print INDEX "{LN}\">"; - print INDEX encode_entities ($c->{MESSAGE}); - print INDEX ""; - if (exists $c->{FILE}) { - print INDEX " in $c->{FILE}"; + if (defined ($c->{MATCH})) { + my $href = $gitweb_url; + $href =~ s/\[FILE\]/uri_escape ($c->{FILE})/ge; + $href =~ s/\[LINE\]/$c->{LINE}/g; + $href =~ s/\[BRANCH\]/uri_escape ($vars{'dist_commit'})/e; + + print INDEX ''; + print INDEX encode_entities (substr ($c->{MESSAGE}, + 0, $c->{MATCH})); + print INDEX ''; + print INDEX encode_entities (substr ($c->{MESSAGE}, + $c->{MATCH})); + } else { + print INDEX encode_entities ($c->{MESSAGE}); } + print INDEX " ", log_link ($c->{LN}); print INDEX "

\n"; } else { print INDEX "

→ {HREF}), "\">";