From 95872ab5c8650af9003677b0ad25d05c2d1ae4d0 Mon Sep 17 00:00:00 2001
From: Ian Jackson <ijackson@chiark.greenend.org.uk>
Date: Sun, 11 Sep 2016 18:43:37 +0100
Subject: [PATCH] dgit: lrfetchrefs: Delete unneeded fetched refs, etc.

Fetch only the refs we (think we) are going to use, and delete the
lrfetchrefs (`refs/dgit-fetch/...') versions of those we give another
name to.

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>
---
 TODO.BRANCH |  3 ++-
 dgit        | 62 +++++++++++++++++++++++++++++++++++++++++++++++------
 2 files changed, 58 insertions(+), 7 deletions(-)

diff --git a/TODO.BRANCH b/TODO.BRANCH
index c32550d0..34c462d4 100644
--- a/TODO.BRANCH
+++ b/TODO.BRANCH
@@ -31,4 +31,5 @@ Test that, where appropriate, maint view tags are pushed to dgit git repo
 
  * Mention in-archive copy fix in debian/changelog
 
- * Remove lrfetchrefs at end of fetch_from_archive, for tidyness
+ * Mention in changelog that:
+   Remove lrfetchrefs at end of fetch_from_archive, for tidyness
diff --git a/dgit b/dgit
index 23cae18f..5d1a95c5 100755
--- a/dgit
+++ b/dgit
@@ -36,6 +36,7 @@ use Digest::SHA;
 use Digest::MD5;
 use List::Util qw(any);
 use List::MoreUtils qw(pairwise);
+use Carp;
 
 use Debian::Dgit;
 
@@ -157,6 +158,27 @@ sub rrref () { return server_ref($csuite); }
 sub lrfetchrefs () { return "refs/dgit-fetch/$csuite"; }
 sub lrfetchref () { return lrfetchrefs.'/'.server_branch($csuite); }
 
+# We fetch some parts of lrfetchrefs/*.  Ideally we delete these
+# locally fetched refs because they have unhelpful names and clutter
+# up gitk etc.  So we track whether we have "used up" head ref (ie,
+# whether we have made another local ref which refers to this object).
+#
+# (If we deleted them unconditionally, then we might end up
+# re-fetching the same git objects each time dgit fetch was run.)
+#
+# So, leach use of lrfetchrefs needs to be accompanied by arrangements
+# in git_fetch_us to fetch the refs in question, and possibly a call
+# to lrfetchref_used.
+
+our (%lrfetchrefs_f, %lrfetchrefs_d);
+# $lrfetchrefs_X{lrfetchrefs."/heads/whatever"} = $objid
+
+sub lrfetchref_used ($) {
+    my ($fullrefname) = @_;
+    my $objid = $lrfetchrefs_f{$fullrefname};
+    $lrfetchrefs_d{$fullrefname} = $objid if defined $objid;
+}
+
 sub stripepoch ($) {
     my ($vsn) = @_;
     $vsn =~ s/^\d+\://;
@@ -1606,9 +1628,13 @@ sub ensure_we_have_orig () {
 }
 
 sub git_fetch_us () {
-    my @specs =
-        map { "$_/*" }
-        qw(tags heads), $branchprefix;
+    # Want to fetch only what we are going to use, unless
+    # deliberately-not-ff, in which case we must fetch everything.
+
+    my @specs = deliberately_not_fast_forward ? qw(tags/*) :
+	map { "tags/$_" } debiantags('*',access_basedistro);
+    push @specs, server_branch($csuite);
+    push @specs, qw(heads/*) if deliberately_not_fast_forward;
 
     # This is rather miserable:
     # When git-fetch --prune is passed a fetchspec ending with a *,
@@ -1644,8 +1670,6 @@ sub git_fetch_us () {
 	return m/^(?:$specre)$/o;
     };
 
-    my %lrfetchrefs_f;
-
     my $fetch_iteration = 0;
     FETCH_ITERATION:
     for (;;) {
@@ -1747,12 +1771,14 @@ END
     });
     git_for_each_ref([map { lrfetchrefs."/tags/".$_ } @tagpats], sub {
 	my ($objid,$objtype,$fullrefname,$reftail) = @_;
-	my $lref = "refs".substr($fullrefname, length lrfetchrefs);
+	my $lref = "refs".substr($fullrefname, length(lrfetchrefs));
 	printdebug "offered $lref=$objid\n";
 	if (!defined $here{$lref}) {
 	    my @upd = (@git, qw(update-ref), $lref, $objid, '');
 	    runcmd_ordryrun_local @upd;
+	    lrfetchref_used $fullrefname;
 	} elsif ($here{$lref} eq $objid) {
+	    lrfetchref_used $fullrefname;
 	} else {
 	    print STDERR \
 		"Not updateting $lref from $here{$lref} to $objid.\n";
@@ -1891,6 +1917,25 @@ sub fetch_from_archive () {
         Info => "Dgit field in .dsc from archive",
     };
 
+    my $cwd = getcwd();
+    my $del_lrfetchrefs = sub {
+	changedir $cwd;
+	my $gur;
+	printdebug "del_lrfetchrefs\n";
+	foreach my $fullrefname (sort keys %lrfetchrefs_d) {
+	    my $objid = $lrfetchrefs_d{$fullrefname};
+	    printdebug "del_lrfetchrefs: $fullrefname=$objid.\n";
+	    if (!$gur) {
+		$gur ||= new IO::Handle;
+		open $gur, "|-", qw(git update-ref --stdin) or die $!;
+	    }
+	    printf $gur "delete %s %s\n", $fullrefname, $objid;
+	}
+	if ($gur) {
+	    close $gur or failedcmd "git update-ref delete lrfetchrefs";
+	}
+    };
+
     if (defined $dsc_hash) {
 	fail "missing remote git history even though dsc has hash -".
 	    " could not find ref ".rref()." at ".access_giturl()
@@ -1951,6 +1996,7 @@ But we were not able to obtain any version from the archive or git.
 
 END
 	}
+	unshift @end, $del_lrfetchrefs;
 	return 0;
     }
 
@@ -2098,6 +2144,10 @@ END
 	    dryrun_report @upd_cmd;
 	}
     }
+
+    lrfetchref_used lrfetchref();
+
+    unshift @end, $del_lrfetchrefs;
     return 1;
 }
 
-- 
2.30.2