X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~ianmdlvl/git?p=dgit.git;a=blobdiff_plain;f=dgit;h=95398497b7c4d9ba77208da8297b33b5c949a851;hp=23cae18f2acdbc58528293c191cf5baf210239d7;hb=d9b4c302c1e04e9047b920b2bc40896479fdacb5;hpb=51f61cf75f6614603782edde86261c9d1bd8c769

diff --git a/dgit b/dgit
index 23cae18f..95398497 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;
 }
 
@@ -2600,11 +2650,13 @@ END
 	create_remote_git_repo();
     }
 
-    my @pushrefs = $forceflag."HEAD:".rrref();
+    my @pushrefs = $forceflag.$dgithead.":".rrref();
     foreach my $tw (@tagwants) {
 	my $view = $tw->{View};
 	next unless $view eq 'dgit'
 	    or any { $_ eq $view } access_cfg_tagformats();
+	    # ^ $view is "dgit" or "maint" so this looks for "maint"
+	    # in archive supported tagformats.
 	push @pushrefs, $forceflag."refs/tags/$tw->{Tag}";
     }
 
@@ -3832,6 +3884,7 @@ sub maybe_unapply_patches_again () {
 	if $patches_applied_dirtily & 01;
     rmtree '.pc'
 	if $patches_applied_dirtily & 02;
+    $patches_applied_dirtily = 0;
 }
 
 #----- other building -----
@@ -4020,16 +4073,15 @@ sub cmd_gbp_build {
 	}
 	build_prep();
     }
+    maybe_unapply_patches_again();
     if ($wantsrc < 2) {
 	unless (grep { m/^--git-debian-branch|^--git-ignore-branch/ } @ARGV) {
 	    canonicalise_suite();
 	    push @cmd, "--git-debian-branch=".lbranch();
 	}
 	push @cmd, changesopts();
-	maybe_apply_patches_dirtily();
 	runcmd_ordryrun_local @cmd, @ARGV;
     }
-    maybe_unapply_patches_again();
     printdone "build successful\n";
 }
 sub cmd_git_build { cmd_gbp_build(); } # compatibility with <= 1.0
@@ -4112,6 +4164,7 @@ sub cmd_sbuild {
 	    " building would result in ambiguity about the intended results"
 	    if @unwanted;
     }
+    my $wasdir = must_getcwd();
     changedir "..";
     if (act_local()) {
 	stat_exists $dscfn or fail "$dscfn (in parent directory): $!";
@@ -4140,6 +4193,7 @@ sub cmd_sbuild {
 	    rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
 	}
     }
+    changedir $wasdir;
     maybe_unapply_patches_again();
     printdone "build successful, results in $multichanges\n" or die $!;
 }