viewvcs: add tree view

This also includes some glossary definitions to help users
unfamiliar with git understand the relationship between
trees and blobs.

diff --git a/lib/PublicInbox/ViewDiff.pm b/lib/PublicInbox/ViewDiff.pm
index 8c1853e625557872003af9d74cad0fc13cc3875a..f16c72297926529beadc416a1da43b6d656d0825 100644 (file)
--- a/lib/PublicInbox/ViewDiff.pm
+++ b/lib/PublicInbox/ViewDiff.pm
@@ -10,12 +10,11 @@ package PublicInbox::ViewDiff;
 use strict;
 use v5.10.1;
 use parent qw(Exporter);
-our @EXPORT_OK = qw(flush_diff);
+our @EXPORT_OK = qw(flush_diff uri_escape_path);
 use URI::Escape qw(uri_escape_utf8);
 use PublicInbox::Hval qw(ascii_html to_attr);
 use PublicInbox::Git qw(git_unquote);
 
-my $UNSAFE = "^A-Za-z0-9\-\._~/"; # '/' + $URI::Escape::Unsafe{RFC3986}
 my $OID_NULL = '0{7,}';
 my $OID_BLOB = '[a-f0-9]{7,}';
 my $LF = qr!\n!;
@@ -41,6 +40,11 @@ our $EXTRACT_DIFFS = qr/(
                ^\+{3}\x20($FN)$LF)/msx;
 our $IS_OID = qr/\A$OID_BLOB\z/s;
 
+sub uri_escape_path {
+       # '/' + $URI::Escape::Unsafe{RFC3986}
+       uri_escape_utf8($_[0], "^A-Za-z0-9\-\._~/");
+}
+
 # link to line numbers in blobs
 sub diff_hunk ($$$$) {
        my ($dst, $dctx, $ca, $cb) = @_;
@@ -123,14 +127,14 @@ sub diff_header ($$$) {
        $pa = (split(m'/', git_unquote($pa), 2))[1] if $pa ne '/dev/null';
        $pb = (split(m'/', git_unquote($pb), 2))[1] if $pb ne '/dev/null';
        if ($pa eq $pb && $pb ne '/dev/null') {
-               $dctx->{Q} = "?b=".uri_escape_utf8($pb, $UNSAFE);
+               $dctx->{Q} = '?b='.uri_escape_path($pb);
        } else {
                my @q;
                if ($pb ne '/dev/null') {
-                       push @q, 'b='.uri_escape_utf8($pb, $UNSAFE);
+                       push @q, 'b='.uri_escape_path($pb);
                }
                if ($pa ne '/dev/null') {
-                       push @q, 'a='.uri_escape_utf8($pa, $UNSAFE);
+                       push @q, 'a='.uri_escape_path($pa);
                }
                $dctx->{Q} = '?'.join('&', @q);
        }

diff --git a/lib/PublicInbox/ViewVCS.pm b/lib/PublicInbox/ViewVCS.pm
index fd95e24e3c54270e8a9bc1a138d13220938c8980..a5545bcd344aba5bda386ee2274dd081be740e3c 100644 (file)
--- a/lib/PublicInbox/ViewVCS.pm
+++ b/lib/PublicInbox/ViewVCS.pm
@@ -21,7 +21,7 @@ use PublicInbox::GitAsyncCat;
 use PublicInbox::WwwStream qw(html_oneshot);
 use PublicInbox::Linkify;
 use PublicInbox::Tmpfile;
-use PublicInbox::ViewDiff qw(flush_diff);
+use PublicInbox::ViewDiff qw(flush_diff uri_escape_path);
 use PublicInbox::View;
 use PublicInbox::Eml;
 use Text::Wrap qw(wrap);
@@ -37,6 +37,14 @@ my $BIN_DETECT = 8000; # same as git
 my $SHOW_FMT = '--pretty=format:'.join('%n', '%P', '%p', '%H', '%T', '%s', '%f',
        '%an <%ae>  %ai', '%cn <%ce>  %ci', '%b%x00');
 
+my %GIT_MODE = (
+       '100644' => ' ', # blob
+       '100755' => 'x', # executable blob
+       '040000' => 'd', # tree
+       '120000' => 'l', # symlink
+       '160000' => 'g', # commit (gitlink)
+);
+
 sub html_page ($$;@) {
        my ($ctx, $code) = @_[0, 1];
        my $wcb = delete $ctx->{-wcb};
@@ -57,7 +65,7 @@ sub dbg_log ($) {
                return '<pre>debug log read error</pre>';
        };
        $ctx->{-linkify} //= PublicInbox::Linkify->new;
-       '<pre>debug log:</pre><hr /><pre>'.
+       "<hr><pre>debug log:\n\n".
                $ctx->{-linkify}->to_html($log).'</pre>';
 }
 
@@ -95,7 +103,7 @@ sub stream_large_blob ($$) {
        $qsp->psgi_return($env, undef, \&stream_blob_parse_hdr, $ctx);
 }
 
-sub show_other_result ($$) { # tag, tree, ...
+sub show_other_result ($$) { # tag
        my ($bref, $ctx) = @_;
        if (my $qsp_err = delete $ctx->{-qsp_err}) {
                return html_page($ctx, 500, dbg_log($ctx) .
@@ -296,7 +304,7 @@ sub show_other ($$) {
        my ($ctx, $res) = @_;
        my ($git, $oid, $type, $size) = @$res;
        $size > $MAX_SIZE and return html_page($ctx, 200,
-                               "$oid is too big to show\n". dbg_log($ctx));
+               ascii_html($type)." $oid is too big to show\n". dbg_log($ctx));
        my $cmd = ['git', "--git-dir=$git->{git_dir}",
                qw(show --encoding=UTF-8 --no-color --no-abbrev), $oid ];
        my $qsp = PublicInbox::Qspawn->new($cmd);
@@ -304,6 +312,78 @@ sub show_other ($$) {
        $qsp->psgi_qx($ctx->{env}, undef, \&show_other_result, $ctx);
 }
 
+sub show_tree_result ($$) {
+       my ($bref, $ctx) = @_;
+       if (my $qsp_err = delete $ctx->{-qsp_err}) {
+               return html_page($ctx, 500, dbg_log($ctx) .
+                               "git ls-tree -z error:$qsp_err");
+       }
+       my @ent = split(/\0/, $$bref);
+       my $qp = delete $ctx->{qp};
+       my $l = $ctx->{-linkify} //= PublicInbox::Linkify->new;
+       my $pfx = $qp->{b};
+       $$bref = "<pre><a href=#tree>tree</a> $ctx->{tree_oid}";
+       if (defined $pfx) {
+               my $x = ascii_html($pfx);
+               $pfx .= '/';
+               $$bref .= qq(  <a href=#path>path</a>: $x</a>\n);
+       } else {
+               $pfx = '';
+               $$bref .= qq[  (<a href=#path>path</a> unknown)\n];
+       }
+       my ($x, $m, $t, $oid, $sz, $f, $n);
+       $$bref .= "\n   size    name";
+       for (@ent) {
+               ($x, $f) = split(/\t/, $_, 2);
+               undef $_;
+               ($m, $t, $oid, $sz) = split(/ +/, $x, 4);
+               $m = $GIT_MODE{$m} // '?';
+               utf8::decode($f);
+               $n = ascii_html($f);
+               if ($m eq 'g') { # gitlink submodule commit
+                       $$bref .= "\ng\t\t$n @ <a\nhref=#g>commit</a>$oid";
+                       next;
+               }
+               my $q = 'b='.ascii_html(uri_escape_path($pfx.$f));
+               if ($m eq 'd') { $n .= '/' }
+               elsif ($m eq 'x') { $n = "<b>$n</b>" }
+               elsif ($m eq 'l') { $n = "<i>$n</i>" }
+               $$bref .= qq(\n$m\t$sz\t<a\nhref="../../$oid/s/?$q">$n</a>);
+       }
+       $$bref .= dbg_log($ctx);
+       $$bref .= <<EOM;
+<pre>glossary
+--------
+<dfn
+id=tree>Tree</dfn> objects belong to commits or other tree objects.  Trees may
+reference blobs, sub-trees, or commits of submodules.
+
+<dfn
+id=path>Path</dfn> names are stored in tree objects, but trees do not know
+their own path name.  A tree's path name comes from their parent tree,
+or it is the root tree referenced by a commit object.  Thus, this web UI
+relies on the `b=' URI parameter as a hint to display the path name.
+
+<dfn title="submodule commit"
+id=g>Commit</dfn> objects may be stored in trees to reference submodules.</pre>
+EOM
+       chop $$bref;
+       html_page($ctx, 200, $$bref);
+}
+
+sub show_tree ($$) {
+       my ($ctx, $res) = @_;
+       my ($git, $oid, undef, $size) = @$res;
+       $size > $MAX_SIZE and return html_page($ctx, 200,
+                       "tree $oid is too big to show\n". dbg_log($ctx));
+       my $cmd = [ 'git', "--git-dir=$git->{git_dir}",
+               qw(ls-tree -z -l --no-abbrev), $oid ];
+       my $qsp = PublicInbox::Qspawn->new($cmd);
+       $ctx->{tree_oid} = $oid;
+       $qsp->{qsp_err} = \($ctx->{-qsp_err} = '');
+       $qsp->psgi_qx($ctx->{env}, undef, \&show_tree_result, $ctx);
+}
+
 # user_cb for SolverGit, called as: user_cb->($result_or_error, $uarg)
 sub solve_result {
        my ($res, $ctx) = @_;
@@ -313,6 +393,7 @@ sub solve_result {
 
        my ($git, $oid, $type, $size, $di) = @$res;
        return show_commit($ctx, $res) if $type eq 'commit';
+       return show_tree($ctx, $res) if $type eq 'tree';
        return show_other($ctx, $res) if $type ne 'blob';
        my $path = to_filename($di->{path_b} // $hints->{path_b} // 'blob');
        my $raw_link = "(<a\nhref=$path>raw</a>)";