use Digest::MD5;
use List::Util qw(any);
use List::MoreUtils qw(pairwise);
+use Carp;
use Debian::Dgit;
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+\://;
}
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 *,
return m/^(?:$specre)$/o;
};
- my %lrfetchrefs_f;
-
my $fetch_iteration = 0;
FETCH_ITERATION:
for (;;) {
});
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";
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()
END
}
+ unshift @end, $del_lrfetchrefs;
return 0;
}
dryrun_report @upd_cmd;
}
}
+
+ lrfetchref_used lrfetchref();
+
+ unshift @end, $del_lrfetchrefs;
return 1;
}
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}";
}
if $patches_applied_dirtily & 01;
rmtree '.pc'
if $patches_applied_dirtily & 02;
+ $patches_applied_dirtily = 0;
}
#----- other building -----
}
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
" 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): $!";
rename "$cf", "$cf.inmulti" or fail "$cf\{,.inmulti}: $!";
}
}
+ changedir $wasdir;
maybe_unapply_patches_again();
printdone "build successful, results in $multichanges\n" or die $!;
}