sub changedir ($) {
my ($newdir) = @_;
printdebug "CD $newdir\n";
- chdir $newdir or die "chdir: $newdir: $!";
+ chdir $newdir or confess "chdir: $newdir: $!";
}
sub deliberately ($) {
return $c;
}
+sub commit_getclogp ($) {
+ # Returns the parsed changelog hashref for a particular commit
+ my ($objid) = @_;
+ our %commit_getclogp_memo;
+ my $memo = $commit_getclogp_memo{$objid};
+ return $memo if $memo;
+ mkpath '.git/dgit';
+ my $mclog = ".git/dgit/clog-$objid";
+ runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
+ "$objid:debian/changelog";
+ $commit_getclogp_memo{$objid} = parsechangelog("-l$mclog");
+}
+
sub must_getcwd () {
my $d = getcwd();
defined $d or fail "getcwd failed: $!";
if ($lastpush_mergeinput) {
my $lastpush_hash = $lastpush_mergeinput->{Commit};
runcmd @git, qw(reset -q --hard), $lastpush_hash;
- runcmd qw(sh -ec), 'dpkg-parsechangelog >>../changelogold.tmp';
- my $oldclogp = parsecontrol('../changelogold.tmp','previous changelog');
+ my $oldclogp = mergeinfo_getclogp($lastpush_mergeinput);
my $oversion = getfield $oldclogp, 'Version';
my $vcmp =
version_compare($oversion, $cversion);
}
sub mergeinfo_getclogp ($) {
- my ($mi) = @_;
# Ensures thit $mi->{Clogp} exists and returns it
- return $mi->{Clogp} if $mi->{Clogp};
- my $mclog = ".git/dgit/clog-$mi->{Commit}";
- mkpath '.git/dgit';
- runcmd shell_cmd "exec >$mclog", @git, qw(cat-file blob),
- "$mi->{Commit}:debian/changelog";
- $mi->{Clogp} = parsechangelog("-l$mclog");
+ my ($mi) = @_;
+ $mi->{Clogp} = commit_getclogp($mi->{Commit});
}
sub mergeinfo_version ($) {
}
sub fetch_from_archive () {
- # Ensures that lrref() is what is actually in the archive,
- # one way or another. If there is nothing in the archive,
- # leaves lrref alone and returns 0.
+ # Ensures that lrref() is what is actually in the archive, one way
+ # or another, according to us - ie this client's
+ # appropritaely-updated archive view. Also returns the commit id.
+ # If there is nothing in the archive, leaves lrref alone and
+ # returns undef. git_fetch_us must have already been called.
get_archive_dsc();
if ($dsc) {
my $del_lrfetchrefs = sub {
changedir $cwd;
my $gur;
- printdebug "del_lrfetchrefs\n";
+ printdebug "del_lrfetchrefs...\n";
foreach my $fullrefname (sort keys %lrfetchrefs_d) {
my $objid = $lrfetchrefs_d{$fullrefname};
- printdebug "del_lrfetchrefs: $fullrefname=$objid.\n";
+ printdebug "del_lrfetchrefs: $objid $fullrefname\n";
if (!$gur) {
$gur ||= new IO::Handle;
open $gur, "|-", qw(git update-ref --stdin) or die $!;
END
}
unshift @end, $del_lrfetchrefs;
- return 0;
+ return undef;
}
if ($lastfetch_hash &&
lrfetchref_used lrfetchref();
unshift @end, $del_lrfetchrefs;
- return 1;
+ return $hash;
}
sub set_local_git_config ($$) {
if (check_for_git()) {
git_fetch_us();
}
- my $forceflag = '';
- if (fetch_from_archive()) {
- if (is_fast_fwd(lrref(), 'HEAD')) {
- # ok
- } elsif (deliberately_not_fast_forward) {
- $forceflag = '+';
- } else {
- fail "dgit push: HEAD is not a descendant".
- " of the archive's version.\n".
- "dgit: To overwrite its contents,".
- " use git merge -s ours ".lrref().".\n".
- "dgit: To rewind history, if permitted by the archive,".
- " use --deliberately-not-fast-forward";
- }
- } else {
+ my $archive_hash = fetch_from_archive();
+ if (!$archive_hash) {
$new_package or
fail "package appears to be new in this suite;".
" if this is intentional, use --new";
}
check_not_dirty();
+
+ my $forceflag = '';
+ if ($archive_hash) {
+ if (is_fast_fwd($archive_hash, $dgithead)) {
+ # ok
+ } elsif (deliberately_not_fast_forward) {
+ $forceflag = '+';
+ } else {
+ fail "dgit push: HEAD is not a descendant".
+ " of the archive's version.\n".
+ "dgit: To overwrite its contents,".
+ " use git merge -s ours ".lrref().".\n".
+ "dgit: To rewind history, if permitted by the archive,".
+ " use --deliberately-not-fast-forward";
+ }
+ }
+
changedir $ud;
progress "checking that $dscfn corresponds to HEAD";
runcmd qw(dpkg-source -x --),