TODO.BRANCH: add some desires

[dgit.git] / dgit

diff --git a/dgit b/dgit
index 23cae18f2acdbc58528293c191cf5baf210239d7..95398497b7c4d9ba77208da8297b33b5c949a851 100755 (executable)
--- 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 $!;
 }