gitweb: Make git_get_refs_list do work of git_get_references

Make git_get_refs_list do also work of git_get_references, to avoid calling git-peek-remote twice. It now returns either list of refs as before in scalar context, or references hash and list of refs in list context. Change meaning of git_get_refs_list meaning: it is now type, and not a full path, e.g. we now use git_get_refs_list("heads") instead of former git_get_refs_list("refs/heads").

Additionally modify git_summary to use only one call to git_get_refs_list instead of one call to git_get_references and two to git_get_refs_list.

---
This was supposed to make gitweb performance better, by
(in the case of git_summary) replacing three calls to git-peek-remote (or one reading info/refs and two calls to git-peek-remote) by only one such a call. ApacheBench shows that after changes summary and tags views are slower, while heads remains the same.

3520.593 +/- 29.2 ms after vs 3086.579 +/- 85.0 ms before (summary) 3137.274 +/- 26.4 ms after vs 2504.025 +/- 46.1 ms before (tags)

I suspect benchmarks somewhat, but still...

 gitweb/gitweb.perl |   57 ++++++++++++++++++++++++++++++----------------------
 1 files changed, 33 insertions(+), 24 deletions(-)

index 7908793..d5ce675 100755
@@ -1077,7 +1077,8 @@ ## .....................................
 ## parse to array of hashes functions
 
 sub git_get_refs_list {
-	my $ref_dir = shift;
+	my $type = shift || "";
+	my %refs;
 	my @reflist;
 
 	my @refs;

@@ -1085,14 +1086,21 @@ sub git_get_refs_list {
 		or return;
 	while (my $line = <$fd>) {
 		chomp $line;
-		if ($line =~ m/^([0-9a-fA-F]{40})\t$ref_dir\/?([^\^]+)$/) {
-			push @refs, { hash => $1, name => $2 };
-		} elsif ($line =~ m/^[0-9a-fA-F]{40}\t$ref_dir\/?(.*)\^\{\}$/ &&
-		         $1 eq $refs[-1]{'name'}) {
-			# most likely a tag is followed by its peeled
-			# (deref) one, and when that happens we know the
-			# previous one was of type 'tag'.
-			$refs[-1]{'type'} = "tag";
+		if ($line =~ m/^([0-9a-fA-F]{40})\trefs\/($type\/?([^\^]+))(\^\{\})?$/) {
+			if (defined $refs{$1}) {
+				push @{$refs{$1}}, $2;
+			} else {
+				$refs{$1} = [ $2 ];
+			}
+
+			if (! $4) { # unpeeled, direct reference
+				push @refs, { hash => $1, name => $3 }; # without type
+			} elsif ($1 eq $refs[-1]{'name'}) {
+				# most likely a tag is followed by its peeled
+				# (deref) one, and when that happens we know the
+				# previous one was of type 'tag'.
+				$refs[-1]{'type'} = "tag";
+			}
 		}
 	}
 	close $fd;

@@ -1108,7 +1116,7 @@ sub git_get_refs_list {
 	}
 	# sort refs by age
 	@reflist = sort {$b->{'epoch'} <=> $a->{'epoch'}} @reflist;
-	return \@reflist;
+	return wantarray ? (\%refs, \@reflist) : \@reflist;
 }
 
 ## ----------------------------------------------------------------------

@@ -2072,14 +2080,14 @@ sub git_tags_body {
 
 sub git_heads_body {
 	# uses global variable $project
-	my ($taglist, $head, $from, $to, $extra) = @_;
+	my ($headlist, $head, $from, $to, $extra) = @_;
 	$from = 0 unless defined $from;
-	$to = $#{$taglist} if (!defined $to || $#{$taglist} < $to);
+	$to = $#{$headlist} if (!defined $to || $#{$headlist} < $to);
 
 	print "<table class=\"heads\" cellspacing=\"0\">\n";
 	my $alternate = 0;
 	for (my $i = $from; $i <= $to; $i++) {
-		my $entry = $taglist->[$i];
+		my $entry = $headlist->[$i];
 		my %tag = %$entry;
 		my $curr = $tag{'id'} eq $head;
 		if ($alternate) {

@@ -2249,7 +2257,8 @@ sub git_summary {
 
 	my $owner = git_get_project_owner($project);
 
-	my $refs = git_get_references();
+	my ($refs, $reflist) = git_get_refs_list();
+
 	git_header_html();
 	git_print_page_nav('summary','', $head);
 

@@ -2279,17 +2288,17 @@ sub git_summary {
 	git_shortlog_body(\@revlist, 0, 15, $refs,
 	                  $cgi->a({-href => href(action=>"shortlog")}, "..."));
 
-	my $taglist = git_get_refs_list("refs/tags");
-	if (defined @$taglist) {
+	my @taglist = map { s!^tags/!! } grep { m!^tags/! } @$reflist;
+	if (@taglist) {
 		git_print_header_div('tags');
-		git_tags_body($taglist, 0, 15,
+		git_tags_body(\@taglist, 0, 15,
 		              $cgi->a({-href => href(action=>"tags")}, "..."));
 	}
 
-	my $headlist = git_get_refs_list("refs/heads");
-	if (defined @$headlist) {
+	my @headlist = map { s!^heads/!! } grep { m!^heads/! } @$reflist;
+	if (@headlist) {
 		git_print_header_div('heads');
-		git_heads_body($headlist, $head, 0, 15,
+		git_heads_body(\@headlist, $head, 0, 15,
 		               $cgi->a({-href => href(action=>"heads")}, "..."));
 	}
 

@@ -2500,7 +2509,7 @@ sub git_tags {
 	git_print_page_nav('','', $head,undef,$head);
 	git_print_header_div('summary', $project);
 
-	my $taglist = git_get_refs_list("refs/tags");
+	my $taglist = git_get_refs_list("tags");
 	if (defined @$taglist) {
 		git_tags_body($taglist);
 	}

@@ -2513,9 +2522,9 @@ sub git_heads {
 	git_print_page_nav('','', $head,undef,$head);
 	git_print_header_div('summary', $project);
 
-	my $taglist = git_get_refs_list("refs/heads");
-	if (defined @$taglist) {
-		git_heads_body($taglist, $head);
+	my $headlist = git_get_refs_list("heads");
+	if (defined @$headlist) {
+		git_heads_body($headlist, $head);
 	}
 	git_footer_html();
 }

1.4.2.1

Instead of trying to read info/refs file, which might not be present (we did fallback to git-ls-remote), always use git-peek-remote in git_get_references.

It is preparation for git_get_refs_info to also return references info. We cannot use info/refs for git_get_refs_info as the information contained therein is usually stale.

---
This patch should be before the one it is reply to, i.e.
gitweb: Make git_get_refs_list do work of git_get_references

 gitweb/gitweb.perl |   10 ++--------
 1 files changed, 2 insertions(+), 8 deletions(-)

index a81c8d4..8c3c13d 100755
@@ -786,16 +786,10 @@ sub git_get_project_owner {
 sub git_get_references {
 	my $type = shift || "";
 	my %refs;
-	my $fd;
 	# 5dc01c595e6c6ec9ccda4f6f69c131c0dd945f8c	refs/tags/v2.6.11
 	# c39ae07f393806ccf406ef966e9a15afc43cc36a	refs/tags/v2.6.11^{}
-	if (-f "$projectroot/$project/info/refs") {
-		open $fd, "$projectroot/$project/info/refs"
-			or return;
-	} else {
-		open $fd, "-|", git_cmd(), "ls-remote", "."
-			or return;
-	}
+	open my $fd, "-|", $GIT, "peek-remote", "$projectroot/$project/"
+		or return;
 
 	while (my $line = <$fd>) {
 		chomp $line;

1.4.2.1

This was because the additional test you proposed for "it is tag if it is followed by deref" was implemented incorrectly. Corrected in "take 3" of this patch.

Corrected in "take 3" of this patch.

And I see that this cleanup is incomplete (%tag = %$entry). Gaah. Should I split cleanup patch?

Gaah. It should be either
if (defined $arrayref)
or

	if (@$arrayref)
or (if one is truly paranoid) ;-)
	if (defined $arrayref && ref($arrayref) eq "ARRAY" && @$arrayref)

[...]

Will do. Unless someone will do this first.

Jakub Narebski
Poland

Which somehow didn't get to the list...

Jakub Narebski
Warsaw, Poland
ShadeHawk on #git

And "take 2" didn't get to the list either.

Stupid filters, or should I just wait a bit?

Jakub Narebski
Warsaw, Poland
ShadeHawk on #git

I do not think we want to have too many functions that return different things depending on contexts. Forcing callers to remember what the function does in which context is bad. You seem to like writing:

my $value = that_function(@args)

but I'd
rather see all callers to say:

	my ($value) = that_function(@args);

even when they expect just one value from the function. One less thing to remember, and one less source of surprises.

Especially for this particular case, you are not even avoiding extra computation when you are only returning list, so I do not think making the return value depend on the calling context is buying you much.

Junio> I do not think we want to have too many functions that return Junio> different things depending on contexts. Forcing callers to Junio> remember what the function does in which context is bad.

That's even an inaccurate description, so an expert in Perl (I've known a few) would just scratch his head.

You cannot ever ever return a list in a scalar context. Ever. Never ever.

You can return an array ref that *contains* a list of references, sure. Perhaps that's what you mean, as in:

return [$ref1, $ref2, $ref3, $ref4]; # scalar return

But to be sloppy about the terminology confuses me. For example, I can't tell from your description if you mean the list-value return is:

return \%some_hash, $ref1, $ref2, $ref3, $ref4; # list return: N items

Or, reverse engineering your sloppiness on the other description, you *MIGHT* mean:

return \%some_hash, [$ref1, $ref2, $ref3, $ref4]; # list return: 2 items

Perl5 does *no* implicit referencing/dereferencing (just like C). So yes, being precise with your language is necessary.

Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[email protected]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!

That much I think I know.

The code I was complaining about tries to do something like this:

	sub that_sub {
        	...
                return wantarray ? (\@bar, \%foo) : \@bar;
	}

and it is not done for optimization purposes (i.e. "if the caller only wants one and we are returning \@bar then we do not have to compute \%foo which is a big win" is not why it does this wantarray business).

So the callers when interested in the sequence of things in 'bar' typically say:

	my $the_list = that_sub(...);
        for (@$the_list) {
        	...
	}

while other callers say:

	my ($the_hash, $the_list) = that_sub(...);
	... use %$the_hash and @$the_list as see fit ...

And I was saying that getting rid of the "return wantwarray ? :" business and write the first class of callers like this

	my ($the_list) = that_sub(...);
        for (@$the_list) {
        	...
	}

would be much less confusing.

Note. I did not mean to imply conditional return should be done for performance reasons.

And I do not think the way this conditional return is done serves better DWIMmery, which was my primary complaint. So I should probably have said "It's not for better DWIM, it is not even for better performance, and I do not see a point".

Junio> That much I think I know.

I think you know too. I even know now that you think you know. :)

The comment was more for Jakub, I believe.

Randal L. Schwartz - Stonehenge Consulting Services, Inc. - +1 503 777 0095
<[email protected]> <URL:http://www.stonehenge.com/merlyn/>
Perl/Unix/security consulting, Technical writing, Comedy, etc. etc.
See PerlTraining.Stonehenge.com for onsite and open-enrollment Perl training!