END { $? = $Debian::Dgit::ExitStatus::desired // -1; };
use Debian::Dgit::GDR;
use Debian::Dgit::ExitStatus;
+use Debian::Dgit::I18n;
use strict;
use Memoize;
use Carp;
use POSIX;
+use Locale::gettext;
use Data::Dumper;
use Getopt::Long qw(:config posix_default gnu_compat bundling);
use Dpkg::Version;
$debugcmd_when_debuglevel = 2;
-our ($usage_message) = <<'END';
+our ($usage_message) = i_ <<'END';
usages:
git-debrebase [<options>] [--|-i <git rebase options...>]
git-debrebase [<options>] status
See git-debrebase(1), git-debrebase(5), dgit-maint-debrebase(7) (in dgit).
END
-our ($opt_force, $opt_noop_ok, @opt_anchors);
+our ($opt_force, $opt_noop_ok, $opt_merges, @opt_anchors);
our ($opt_defaultcmd_interactive);
our $us = qw(git-debrebase);
-our $wrecknoteprefix = 'refs/debrebase-wreckage';
+our $wrecknoteprefix = 'refs/debrebase/wreckage';
+our $merge_cache_ref = 'refs/debrebase/merge-resolutions';
$|=1;
sub badusage ($) {
my ($m) = @_;
- print STDERR "$us: bad usage: $m\n";
+ print STDERR f_ "%s: bad usage: %s\n", $us, $m;
finish 8;
}
}
sub getoptions {
my $sc = shift;
- getoptions_main "bad options follow \`git-debrebase $sc'", @_;
+ getoptions_main +(f_ "bad options follow \`git-debrebase %s'", $sc), @_;
}
sub cfg ($;$) {
push @cmd, $k;
my $out = cmdoutput_errok @cmd;
if (!defined $out) {
- fail "missing required git config $k" unless $optional;
+ fail f_ "missing required git config %s", $k unless $optional;
return ();
}
my @l = split /\0/, $out;
sub get_commit ($) {
my ($objid) = @_;
my $data = (git_cat_file $objid, 'commit');
- $data =~ m/(?<=\n)\n/ or die "$objid ($data) ?";
+ $data =~ m/(?<=\n)\n/ or confess "$objid ($data) ?";
return ($`,$');
}
sub D_UPS () { 0x02; } # upstream files
sub D_PAT_ADD () { 0x04; } # debian/patches/ extra patches at end
sub D_PAT_OTH () { 0x08; } # debian/patches other changes
-sub D_DEB_CLOG () { 0x10; } # debian/ (not patches/ or changelog)
-sub D_DEB_OTH () { 0x20; } # debian/changelog
+sub D_DEB_CLOG () { 0x10; } # debian/changelog
+sub D_DEB_OTH () { 0x20; } # debian/ (not patches/ or changelog)
sub DS_DEB () { D_DEB_CLOG | D_DEB_OTH; } # debian/ (not patches/)
our $playprefix = 'debrebase';
my @upd_cmd = (git_update_ref_cmd "debrebase: $mrest", qw(--stdin));
debugcmd '>|', @upd_cmd;
- open U, "|-", @upd_cmd or die $!;
+ open U, "|-", @upd_cmd or confess $!;
foreach (@$updates) {
printdebug ">= ", $_, "\n";
- print U $_, "\n" or die $!;
+ print U $_, "\n" or confess $!;
}
printdebug ">\$\n";
close U or failedcmd @upd_cmd;
sub run_deferred_updates ($) {
my ($mrest) = @_;
- confess 'dangerous internal error' unless all_snags_summarised();
+ my $m = 'dangerous internal error';
+ confess $m.' - '.__ $m unless all_snags_summarised();
merge_wreckage_cleaning \@deferred_updates;
run_ref_updates_now $mrest, \@deferred_updates;
@deferred_update_messages = ();
}
+sub get_tree ($;$$) {
+ # tree object name => ([ $name, $info ], ...)
+ # where $name is the sort key, ie has / at end for subtrees
+ # $info is the LHS from git-ls-tree (<mode> <type> <hash>)
+ # without $precheck, will crash if $x does not exist, so don't do that;
+ # instead pass '' to get ().
+ my ($x, $precheck, $recurse) = @_;
+
+ return () if !length $x;
+
+ if ($precheck) {
+ my ($type, $dummy) = git_cat_file $x, [qw(tree missing)];
+ return () if $type eq 'missing';
+ }
+
+ $recurse = !!$recurse;
+
+ confess "get_tree needs object not $x ?" unless $x =~ m{^[0-9a-f]+\:};
+
+ our (@get_tree_memo, %get_tree_memo);
+ my $memo = $get_tree_memo{$recurse,$x};
+ return @$memo if $memo;
+
+ local $Debian::Dgit::debugcmd_when_debuglevel = 3;
+ my @l;
+ my @cmd = (qw(git ls-tree -z --full-tree));
+ push @cmd, qw(-r) if $recurse;
+ push @cmd, qw(--), $x;
+ my $o = cmdoutput @cmd;
+ $o =~ s/\0$//s;
+ my $last = '';
+ foreach my $l (split /\0/, $o) {
+ my ($i, $n) = split /\t/, $l, 2;
+ $n .= '/' if $i =~ m/^\d+ tree /;
+ push @l, [ $n, $i ];
+ confess "$x need $last < $n ?" unless $last lt $n;
+ }
+ $get_tree_memo{$recurse,$x} = \@l;
+ push @get_tree_memo, $x;
+ if (@get_tree_memo > 10) {
+ delete $get_tree_memo{ shift @get_tree_memo };
+ }
+ return @l;
+}
+
+sub trees_diff_walk ($$$;$) {
+ # trees_diff_walk [{..opts...},] $x, $y, sub {... }
+ # calls sub->($name, $ix, $iy) for each difference
+ # $x and $y are as for get_tree
+ # where $name, $ix, $iy are $name and $info from get_tree
+ # opts are all call even for names same in both
+ # recurse call even for names same in both
+ my $opts = shift @_ if @_>=4;
+ my ($x,$y,$call) = @_;
+ my $all = $opts->{all};
+ return if !$all and $x eq $y;
+ my @x = get_tree $x, 0, $opts->{recurse};
+ my @y = get_tree $y, 0, $opts->{recurse};
+ printdebug "trees_diff_walk(..$x,$y..) ".Dumper(\@x,\@y)
+ if $debuglevel >= 3;
+ while (@x || @y) {
+ my $cmp = !@x <=> !@y # eg @y empty? $cmp=-1, use x
+ || $x[0][0] cmp $y[0][0]; # eg, x lt y ? $cmp=-1, use x
+ my ($n, $ix, $iy); # all same? $cmp=0, use both
+ $ix=$iy='';
+ printdebug "trees_diff_walk $cmp : @{ $x[0]//[] } | @{ $y[0]//[] }\n"
+ if $debuglevel >= 3;
+ ($n, $ix) = @{ shift @x } if $cmp <= 0;
+ ($n, $iy) = @{ shift @y } if $cmp >= 0;
+ next if !$all and $ix eq $iy;
+ printdebug sprintf
+ "trees_diff_walk(%d,'%s','%s') call('%s','%s','%s')\n",
+ !!$all,$x,$y, $n,$ix,$iy
+ if $debuglevel >= 2;
+ $call->($n, $ix, $iy);
+ }
+}
+
sub get_differs ($$) {
my ($x,$y) = @_;
- # This resembles quiltify_trees_differ, in dgit, a bit.
+ # This does a similar job to quiltify_trees_differ, in dgit, a bit.
# But we don't care about modes, or dpkg-source-unrepresentable
# changes, and we don't need the plethora of different modes.
# Conversely we need to distinguish different kinds of changes to
# debian/ and debian/patches/.
+ # Also, here we have, and want to use, trees_diff_walk, because
+ # we may be calling this an awful lot and we want it to be fast.
my $differs = 0;
+ my @debian_info;
- my $rundiff = sub {
- my ($opts, $limits, $fn) = @_;
- my @cmd = (@git, qw(diff-tree -z --no-renames));
- push @cmd, @$opts;
- push @cmd, "$_:" foreach $x, $y;
- push @cmd, '--', @$limits;
- my $diffs = cmdoutput @cmd;
- foreach (split /\0/, $diffs) { $fn->(); }
- };
+ no warnings qw(exiting);
- $rundiff->([qw(--name-only)], [], sub {
- $differs |= $_ eq 'debian' ? DS_DEB : D_UPS;
- });
+ my $plain = sub { $_[0] =~ m{^(100|0*)644 blob }s; };
- if ($differs & DS_DEB) {
- $differs &= ~DS_DEB;
- $rundiff->([qw(--name-only -r)], [qw(debian)], sub {
- $differs |=
- m{^debian/patches/} ? D_PAT_OTH :
- $_ eq 'debian/changelog' ? D_DEB_CLOG :
- D_DEB_OTH;
- });
- die "mysterious debian changes $x..$y"
- unless $differs & (D_PAT_OTH|DS_DEB);
- }
-
- if ($differs & D_PAT_OTH) {
- my $mode;
- $differs &= ~D_PAT_OTH;
- my $pat_oth = sub {
- $differs |= D_PAT_OTH;
- no warnings qw(exiting); last;
- };
- $rundiff->([qw(--name-status -r)], [qw(debian/patches/)], sub {
- no warnings qw(exiting);
- if (!defined $mode) {
- $mode = $_; next;
+ trees_diff_walk "$x:", "$y:", sub {
+ my ($n,$ix,$iy) = @_;
+
+ # analyse difference at the toplevel
+
+ if ($n ne 'debian/') {
+ $differs |= D_UPS;
+ next;
+ }
+ if ($n eq 'debian') {
+ # one side has a non-tree for ./debian !
+ $differs |= D_DEB_OTH;
+ next;
+ }
+
+ my $xd = $ix && "$x:debian";
+ my $yd = $iy && "$y:debian";
+ trees_diff_walk $xd, $yd, sub {
+ my ($n,$ix,$iy) = @_;
+
+ # analyse difference in debian/
+
+ if ($n eq 'changelog' && (!$ix || $plain->($ix))
+ && $plain->($iy) ) {
+ $differs |= D_DEB_CLOG;
+ next;
}
- die unless s{^debian/patches/}{};
- my $ok;
- if ($mode eq 'A' && !m/\.series$/s) {
- $ok = 1;
- } elsif ($mode eq 'M' && $_ eq 'series') {
- my $x_s = (git_cat_file "$x:debian/patches/series", 'blob');
- my $y_s = (git_cat_file "$y:debian/patches/series", 'blob');
- chomp $x_s; $x_s .= "\n";
- $ok = $x_s eq substr($y_s, 0, length $x_s);
- } else {
- # nope
+ if ($n ne 'patches/') {
+ $differs |= D_DEB_OTH;
+ next;
}
- $mode = undef;
- $differs |= $ok ? D_PAT_ADD : D_PAT_OTH;
- });
- die "mysterious debian/patches changes $x..$y"
- unless $differs & (D_PAT_ADD|D_PAT_OTH);
- }
+
+ my $xp = $ix && "$xd/patches";
+ my $yp = $iy && "$yd/patches";
+ trees_diff_walk { recurse=>1 }, $xp, $yp, sub {
+ my ($n,$ix,$iy) = @_;
+
+ # analyse difference in debian/patches
+
+ my $ok;
+ if ($n =~ m{/$}s) {
+ # we are recursing; directories may appear and disappear
+ $ok = 1;
+ } elsif ($n !~ m/\.series$/s && !$ix && $plain->($iy)) {
+ $ok = 1;
+ } elsif ($n eq 'series' && $plain->($ix) && $plain->($iy)) {
+ my $x_s = (git_cat_file "$xp/series", 'blob');
+ my $y_s = (git_cat_file "$yp/series", 'blob');
+ chomp $x_s; $x_s .= "\n";
+ $ok = $x_s eq substr($y_s, 0, length $x_s);
+ } else {
+ # nope
+ }
+ $differs |= $ok ? D_PAT_ADD : D_PAT_OTH;
+ };
+ };
+ };
printdebug sprintf "get_differs %s %s = %#x\n", $x, $y, $differs;
my ($tag,$msg) = @_; # ignores extra args, for benefit of keycommits
if (grep { $_ eq $tag } @snag_force_opts) {
$snags_forced++;
- print STDERR "git-debrebase: snag ignored (-f$tag): $msg\n";
+ print STDERR f_ "%s: snag ignored (-f%s): %s\n", $us, $tag, $msg;
} else {
$snags_tripped++;
- print STDERR "git-debrebase: snag detected (-f$tag): $msg\n";
+ print STDERR f_ "%s: snag detected (-f%s): %s\n", $us, $tag, $msg;
}
}
sub snags_maybe_bail () {
return if all_snags_summarised();
if ($snags_forced) {
- printf STDERR
+ print STDERR f_
"%s: snags: %d overriden by individual -f options\n",
$us, $snags_forced;
}
if ($snags_tripped) {
if ($opt_force) {
- printf STDERR
+ print STDERR f_
"%s: snags: %d overriden by global --force\n",
$us, $snags_tripped;
} else {
- fail sprintf
+ fail f_
"%s: snags: %d blocker(s) (you could -f<tag>, or --force)",
$us, $snags_tripped;
}
return $snags_forced || $snags_tripped;
}
+sub ffq_prev_branchinfo () {
+ my $current = git_get_symref();
+ return gdr_ffq_prev_branchinfo($current);
+}
+
+sub record_gdrlast ($$;$) {
+ my ($gdrlast, $newvalue, $oldvalue) = @_;
+ $oldvalue ||= $git_null_obj;
+ push @deferred_updates, "update $gdrlast $newvalue $oldvalue";
+}
+
+sub fail_unprocessable ($) {
+ my ($msg) = @_;
+ changedir $maindir;
+ my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo();
+
+ my $mangled = __ <<END;
+Branch/history seems mangled - no longer in gdr format.
+See ILLEGAL OPERATIONS in git-debrebase(5).
+END
+ chomp $mangled;
+
+ if (defined $ffqm) {
+ fail f_ <<END, $msg, $ffqm;
+%s
+Is this meant to be a gdr branch? %s
+END
+ } elsif (git_get_ref $ffq_prev) {
+ fail f_ <<END, $msg, $mangled;
+%s
+%s
+Consider git-debrebase scrap, to throw away your recent work.
+END
+ } elsif (!git_get_ref $gdrlast) {
+ fail f_ <<END, $msg;
+%s
+Branch does not seem to be meant to be a git-debrebase branch?
+Wrong branch, or maybe you needed git-debrebase convert-from-*.
+END
+ } elsif (is_fast_fwd $gdrlast, git_rev_parse 'HEAD') {
+ fail <<END;
+$msg
+$mangled
+END
+ } else {
+ fail f_ <<END, $msg;
+%s
+Branch/history mangled, and diverged since last git-debrebase.
+Maybe you reset to, or rebased from, somewhere inappropriate.
+END
+ }
+};
+
sub gbp_pq_export ($$$) {
my ($bname, $base, $tip) = @_;
# must be run in a workarea. $bname and patch-queue/$bname
# ought not to exist. Leaves you on patch-queue/$bname with
# the patches staged but not committed.
+ # returns 1 if there were any patches
printdebug "gbp_pq_export $bname $base $tip\n";
runcmd @git, qw(checkout -q -b), $bname, $base;
runcmd @git, qw(checkout -q -b), "patch-queue/$bname", $tip;
{ local ($!,$?); copy('../gbp-pq-err', \*STDERR); }
failedcmd @gbp_cmd;
}
- runcmd @git, qw(add -f debian/patches) if stat_exists 'debian/patches';
+ return 0 unless stat_exists 'debian/patches';
+ runcmd @git, qw(add -f debian/patches);
+ return 1;
}
-# xxx allow merge resolution separately from laundering, before git merge
-#
-# xxx general gdr docs highlight forbidden things
-# xxx general gdr docs list allowable things ?
-# xxx general gdr docs explicitly forbid some rebase
-#
-# xxx provide a way for the user to help
-# xxx (eg, provide wreckage provide way to continue)
+# MERGE-TODO allow merge resolution separately from laundering, before git merge
# later/rework?
# use git-format-patch?
$wrecknotes->{$reftail} = $commitish;
}
+sub merge_attempt_cmd {
+ my $wrecknotes = shift @_;
+ debugcmd '+', @_;
+ $!=0; $?=-1;
+ if (system @_) {
+ merge_failed $wrecknotes,
+ failedcmd_waitstatus(),
+ "failed command: @_";
+ }
+}
+
+sub merge_series_patchqueue_convert ($$$);
+
sub merge_series ($$$;@) {
my ($newbase, $wrecknotes, $base_q, @input_qs) = @_;
# $base_q{SeriesBase} $input_qs[]{SeriesBase}
# $prereq{<patch filename>}{<possible prereq} exists or not (later)
# $prereq{<patch filename>} exists or not (even later)
- my $result;
+ my $merged_pq;
my $mwrecknote = sub { &mwrecknote($wrecknotes, @_); };
- my $attempt_cmd = sub {
- debugcmd '+', @_;
- $!=0; $?=-1;
- if (system @_) {
- merge_failed $wrecknotes,
- failedcmd_waitstatus(),
- "failed command: @_";
- }
- };
+ my $attempt_cmd = sub { &merge_attempt_cmd($wrecknotes, @_); };
local $workarea;
fresh_workarea "merge";
playtree_setup();
foreach my $q ($base_q, reverse @input_qs) {
my $s = $q->{MR}{S};
- gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
+ my $any = gbp_pq_export "p-$s", $q->{SeriesBase}, $q->{SeriesTip};
my @earlier;
- if (open S, $seriesfile) {
+ if ($any) {
+ open S, $seriesfile or confess "$seriesfile $!";
while (my $patch = <S>) {
- chomp $patch or die $!;
+ chomp $patch or confess $!;
$prereq{$patch} //= {};
foreach my $earlier (@earlier) {
- $prereq{$patch}{$earlier}{$s}++ and die;
+ $prereq{$patch}{$earlier}{$s}++ and confess;
}
push @earlier, $patch;
- stat "debian/patches/$patch" or die "$patch ?";
+ stat "debian/patches/$patch" or confess "$patch ?";
}
- S->error and die "$seriesfile $!";
+ S->error and confess "$seriesfile $!";
close S;
- } else {
- die "$seriesfile $!" unless $!==ENOENT;
}
read_tree_upstream $newbase, 1;
my $pec = make_commit [ grep { defined } $base_q->{MR}{PEC} ], [
my $authordate = sub {
my ($f) = @_;
$authordate{$f} //= do {
- open PF, "<", "debian/patches/$f" or die "$f $!";
+ open PF, "<", "debian/patches/$f" or confess "$f $!";
while (<PF>) {
return $nodate if m/^$/;
last if s{^Date: }{};
};
};
- open NS, '>', $seriesfile or die $!;
+ open NS, '>', $seriesfile or confess $!;
while (keys %prereq) {
my $best;
$best = $try;
}
printdebug "merge_series series next $best\n";
- print NS "$best\n" or die $!;
+ print NS "$best\n" or confess $!;
delete $prereq{$best};
foreach my $gp (values %prereq) {
delete $gp->{$best};
runcmd @git, qw(add), $seriesfile;
runcmd @git, qw(commit --quiet -m), 'Merged patch queue form';
- $mwrecknote->('merged-patchqueue', git_rev_parse 'HEAD');
+ $merged_pq = git_rev_parse 'HEAD';
+ $mwrecknote->('merged-patchqueue', $merged_pq);
+ };
+ return merge_series_patchqueue_convert
+ $wrecknotes, $newbase, $merged_pq;
+}
+sub merge_series_patchqueue_convert ($$$) {
+ my ($wrecknotes, $newbase, $merged_pq) = @_;
+
+ my $result;
+ in_workarea sub {
+ playtree_setup();
printdebug "merge_series series gbp pq import\n";
+ runcmd @git, qw(checkout -q -b mergec), $merged_pq;
- $attempt_cmd->(qw(gbp pq import));
+ merge_attempt_cmd($wrecknotes, qw(gbp pq import));
+ # MERGE-TODO consider git-format-patch etc. instead,
+ # since gbp pq doesn't always round-trip :-/
# OK now we are on patch-queue/merge, and we need to rebase
# onto the intended parent and drop the patches from each one
printdebug "merge_series series ok, building...\n";
my $build = $newbase;
- my @lcmd = (@git, qw(rev-list --reverse merge..patch-queue/merge));
+ my @lcmd = (@git, qw(rev-list --reverse mergec..patch-queue/mergec));
foreach my $c (grep /./, split /\n/, cmdoutput @lcmd) {
my $commit = git_cat_file $c, 'commit';
printdebug "merge_series series ok, building $c\n";
my $tree = cmdoutput @git, qw(write-tree);
$commit =~ s{^parent (\S+)$}{parent $build}m or confess;
$commit =~ s{^tree (\S+)$}{tree $tree}m or confess;
- open C, ">", "../mcommit" or die $!;
- print C $commit or die $!;
- close C or die $!;
+ open C, ">", "../mcommit" or confess $!;
+ print C $commit or confess $!;
+ close C or confess $!;
$build = cmdoutput @git, qw(hash-object -w -t commit ../mcommit);
}
$result = $build;
- $mwrecknote->('merged-result', $result);
+ mwrecknote($wrecknotes, 'merged-result', $result);
runcmd @git, qw(update-ref refs/heads/result), $result;
runcmd @git, qw(commit --allow-empty -q -m M-WORKTREE);
my $mdebug = git_rev_parse 'HEAD';
printdebug sprintf "merge_series done debug=%s\n", $mdebug;
- $mwrecknote->('merged-debug', $mdebug);
+ mwrecknote($wrecknotes, 'merged-debug', $mdebug);
};
printdebug "merge_series returns $result\n";
return $result;
# $p_ref, if provided, must be [] and is used as a base for Parents
$p_ref //= [];
- die if @$p_ref;
+ confess if @$p_ref;
my ($h,$m) = get_commit $objid;
- my ($t) = $h =~ m/^tree (\w+)$/m or die $objid;
+ my ($t) = $h =~ m/^tree (\w+)$/m or confess $objid;
my (@ph) = $h =~ m/^parent (\w+)$/mg;
my $r = {
# reject it here then we avoid making the pseudomerge which
# would be needed to push it.
- my $badanchor = sub { $unknown->("git-debrebase \`anchor' but @_"); };
- @p == 2 or return $badanchor->("has other than two parents");
- $haspatches and return $badanchor->("contains debian/patches");
+ my $badanchor = sub {
+ $unknown->(f_ "git-debrebase \`anchor' but %s", "@_");
+ };
+ @p == 2 or return $badanchor->(__ "has other than two parents");
+ $haspatches and return $badanchor->(__ "contains debian/patches");
# How to decide about l/r ordering of anchors ? git
# --topo-order prefers to expand 2nd parent first. There's
# parents from left to right, in order, so it's easy to see
# which way round a pseudomerge is.
- $p[0]{IsOrigin} and $badanchor->("is an origin commit");
+ $p[0]{IsOrigin} and $badanchor->(__ "is an origin commit");
$p[1]{Differs} & ~DS_DEB and
- $badanchor->("upstream files differ from left parent");
+ $badanchor->(__ "upstream files differ from left parent");
$p[0]{Differs} & ~D_UPS and
- $badanchor->("debian/ differs from right parent");
+ $badanchor->(__ "debian/ differs from right parent");
return $classify->(qw(Anchor),
OrigParents => [ $p[1] ]);
if ($d == D_PAT_ADD) {
return $classify->(qw(AddPatches));
} elsif ($d & (D_PAT_ADD|D_PAT_OTH)) {
- return $unknown->("edits debian/patches");
+ return $unknown->(__ "edits debian/patches");
} elsif ($d & DS_DEB and !($d & ~DS_DEB)) {
my ($ty,$dummy) = git_cat_file "$p[0]{CommitId}:debian";
if ($ty eq 'tree') {
} elsif ($ty eq 'missing') {
return $classify->(qw(BreakwaterStart));
} else {
- return $unknown->("parent's debian is not a directory");
+ return $unknown->(__ "parent's debian is not a directory");
}
} elsif ($d == D_UPS) {
return $classify->(qw(Upstream));
} elsif ($d & DS_DEB and $d & D_UPS and !($d & ~(DS_DEB|D_UPS))) {
return $classify->(qw(Mixed));
} elsif ($d == 0) {
- return $unknown->("no changes");
+ return $unknown->(__ "no changes");
} else {
confess "internal error $objid ?";
}
}
if (!@p) {
- return $unknown->("origin commit");
+ return $unknown->(__ "origin commit");
}
if (@p == 2 && @identical == 1) {
if (@p == 2 && @identical == 2) {
my $get_t = sub {
my ($ph,$pm) = get_commit $_[0]{CommitId};
- $ph =~ m/^committer .* (\d+) [-+]\d+$/m or die "$_->{CommitId} ?";
+ $ph =~ m/^committer .* (\d+) [-+]\d+$/m
+ or confess "$_->{CommitId} ?";
$1;
};
my @bytime = @p;
if (@p == 2 and
$r->{Msg} =~ m{^\[git-debrebase merged-breakwater.*\]$}m) {
- # xxx ^ metadata tag needs adding to (5)
return $classify->("MergedBreakwaters");
}
if ($r->{Msg} =~ m{^\[(git-debrebase|dgit)[: ].*\]$}m) {
- return $unknown->("unknown kind of merge from $1");
+ return $unknown->(f_ "unknown kind of merge from %s", $1);
}
if (@p > 2) {
- return $unknown->("octopus merge");
+ return $unknown->(__ "octopus merge");
}
- if (!$ENV{GIT_DEBREBASE_EXPERIMENTAL_MERGE}) {
- return $unknown->("general two-parent merge");
+ if (!$opt_merges) {
+ return $unknown->(__ "general two-parent merge");
}
return $classify->("VanillaMerge");
$best_anchor = $panchor
if !defined $best_anchor
or is_fast_fwd $best_anchor, $panchor;
- fail "inconsistent anchors in merged-breakwaters $p->{CommitId}"
+ fail f_ "inconsistent anchors in merged-breakwaters %s",
+ $p->{CommitId}
unless is_fast_fwd $panchor, $best_anchor;
}
return $best_anchor;
my ($head, $furniture, $unclean, $trouble, $fatal, $claimed_bw) = @_;
# => ($anchor, $breakwater)
- # $unclean->("unclean-$tagsfx", $msg, $cl)
# $furniture->("unclean-$tagsfx", $msg, $cl)
- # $dgitimport->("unclean-$tagsfx", $msg, $cl))
+ # $unclean->("unclean-$tagsfx", $msg, $cl)
# is callled for each situation or commit that
# wouldn't be found in a laundered branch
# $furniture is for furniture commits such as might be found on an
my $clogonly;
my $cl;
my $found_pm;
- $fatal //= sub { fail $_[1]; };
+ $fatal //= sub { fail_unprocessable $_[1]; };
my $x = sub {
my ($cb, $tagsfx, $mainwhy, $xwhy) = @_;
my $why = $mainwhy.$xwhy;
- my $m = "branch needs laundering (run git-debrebase): $why";
+ my $m = f_ "branch needs laundering (run git-debrebase): %s", $why;
fail $m unless defined $cb;
return unless $cb;
$cb->("unclean-$tagsfx", $why, $cl, $mainwhy);
$found_anchor->($head);
} elsif ($ty eq 'Upstream') {
$x->($unclean, 'ordering',
- "packaging change ($breakwater) follows upstream change"," (eg $head)")
+ (f_ "packaging change (%s) follows upstream change", $breakwater),
+ (f_ " (eg %s)", $head))
if defined $breakwater;
$clogonly = undef;
$breakwater = undef;
} elsif ($ty eq 'Mixed') {
$x->($unclean, 'mixed',
- "found mixed upstream/packaging commit"," ($head)");
+ (__ "found mixed upstream/packaging commit"),
+ (f_ " (%s)", $head));
$clogonly = undef;
$breakwater = undef;
} elsif ($ty eq 'Pseudomerge' or
$ty eq 'AddPatches') {
my $found_pm = 1;
$x->($furniture, (lc $ty),
- "found interchange bureaucracy commit ($ty)"," ($head)");
+ (f_ "found interchange bureaucracy commit (%s)", $ty),
+ (f_ " (%s)", $head));
} elsif ($ty eq 'DgitImportUnpatched') {
if ($found_pm) {
$x->($trouble, 'dgitimport',
- "found dgit dsc import"," ($head)");
+ (__ "found dgit dsc import"),
+ (f_ " (%s)", $head));
return (undef,undef);
} else {
$x->($fatal, 'unprocessable',
- "found bare dgit dsc import with no prior history",
- " ($head)");
+ (__ "found bare dgit dsc import with no prior history"),
+ (f_ " (%s)", $head));
return (undef,undef);
}
} elsif ($ty eq 'VanillaMerge') {
$x->($trouble, 'vanillamerge',
- "found vanilla merge"," ($head)");
+ (__ "found vanilla merge"),
+ (f_ " (%s)", $head));
return (undef,undef);
} elsif ($ty eq 'MergedBreakwaters') {
$found_anchor->(mergedbreakwaters_anchor $cl);
} else {
$x->($fatal, 'unprocessable',
- "found unprocessable commit, cannot cope: $cl->{Why}",
- " ($head)");
+ (f_ "found unprocessable commit, cannot cope: %s",
+ $cl->{Why}),
+ (f_ " (%s)", $head));
return (undef,undef);
}
$head = $cl->{Parents}[0]{CommitId};
my $cl;
my $xmsg = sub {
my ($prose, $info) = @_;
+ # We deliberately do not translate $prose, since this mostly
+ # appears in commits in Debian and they should be in English.
my $ms = $cl->{Msg};
chomp $ms;
- $info //= '';
- $ms .= "\n\n[git-debrebase$info: $prose]\n";
+ confess unless defined $info;
+ $ms .= "\n\n[git-debrebase $info: $prose]\n";
return (Msg => $ms);
};
my $rewrite_from_here = sub {
if ($nogenerate) {
return (undef,undef);
}
- fail "found unprocessable commit, cannot cope".
- (defined $cl->{Why} ? "; $cl->{Why}:": ':').
- " (commit $cur) (d.".
- (join ' ', map { sprintf "%#x", $_->{Differs} }
- @{ $cl->{Parents} }).
- ")";
+ my $d =
+ join ' ',
+ map { sprintf "%#x", $_->{Differs} }
+ @{ $cl->{Parents} };
+ fail_unprocessable f_ +(defined $cl->{Why}
+ ? i_ 'found unprocessable commit, cannot cope; %3$s: (commit %1$s) (d.%2$s)'
+ : i_ 'found unprocessable commit, cannot cope: (commit %1$s) (d.%2$s)'),
+ $cur, $d, $cl->{Why};
};
my $build;
} elsif ($ty eq 'Mixed') {
my $queue = sub {
my ($q, $wh) = @_;
- my $cls = { %$cl, $xmsg->("split mixed commit: $wh part") };
+ my $cls = { %$cl, $xmsg->("mixed commit: $wh part",'split') };
push @$q, $cls;
};
$queue->(\@brw_cl, "debian");
push @brw_cl, {
%$cl,
SpecialMethod => 'DgitImportDebianUpdate',
- $xmsg->("convert dgit import: debian changes")
+ $xmsg->("debian changes", 'convert dgit import')
}, {
%$cl,
SpecialMethod => 'DgitImportUpstreamUpdate',
$xmsg->("convert dgit import: upstream update",
- " anchor")
+ "anchor")
};
$prline->(" Import");
$rewrite_from_here->(\@brw_cl);
# patches as commits. Unfortunately it contains
# debian/patches/.
printdebug "*** WALK BOMB bare dgit import\n";
- $cl->{Why} = "bare dgit dsc import";
+ $cl->{Why} = __ "bare dgit dsc import";
return $bomb->();
}
- die "$ty ?";
+ confess "$ty ?";
} elsif ($ty eq 'MergedBreakwaters') {
$last_anchor = mergedbreakwaters_anchor $cl;
$build_start->(' MergedBreakwaters', $cur);
# which was reachable via ffq-prev is no longer findable.
# This is suboptimal, but if it all works we'll have done
# the right thing.
- # xxx we should warn the user in the docs about this
+ # MERGE-TODO we should warn the user in the docs about this
my $ok=1;
my $best_anchor;
%$cl,
SpecialMethod => 'MergeCreateMergedBreakwaters',
$xmsg->('constructed from vanilla merge',
- ' merged-breakwater'),
+ 'merged-breakwater'),
};
push @upp_cl, {
%$cl,
my $rewriting = 0;
- my $read_tree_upstream = sub {
- my ($treeish) = @_;
- read_tree_upstream $treeish, 0, $build;
- };
-
$#upp_cl = $upp_limit if defined $upp_limit;
my $committer_authline = calculate_committer_authline();
printdebug "WALK REBUILD $build ".(scalar @processed)."\n";
- confess "internal error" unless $build eq (pop @processed)->{CommitId};
+ confess __ "internal error" unless $build eq (pop @processed)->{CommitId};
in_workarea sub {
- mkdir $rd or $!==EEXIST or die $!;
+ mkdir $rd or $!==EEXIST or confess $!;
my $current_method;
- runcmd @git, qw(read-tree), $build;
+ my $want_debian = $build;
+ my $want_upstream = $build;
+
+ my $read_tree_upstream = sub { ($want_upstream) = @_; };
+ my $read_tree_debian = sub { ($want_debian) = @_; };
+
foreach my $cl (qw(Debian), (reverse @brw_cl),
{ SpecialMethod => 'RecordBreakwaterTip' },
qw(Upstream), (reverse @upp_cl)) {
printdebug "WALK BUILD ".($cltree//'undef').
" $method (rewriting=$rewriting)\n";
if ($method eq 'Debian') {
- read_tree_debian($cltree);
+ $read_tree_debian->($cltree);
} elsif ($method eq 'Upstream') {
$read_tree_upstream->($cltree);
} elsif ($method eq 'StartRewrite') {
$breakwater = $build;
next;
} elsif ($method eq 'DgitImportDebianUpdate') {
- read_tree_debian($cltree);
+ $read_tree_debian->($cltree);
} elsif ($method eq 'DgitImportUpstreamUpdate') {
confess unless $rewriting;
my $differs = (get_differs $build, $cltree);
print "Found a general merge, will try to tidy it up.\n";
$rewriting = 1;
$read_tree_upstream->($cl->{MergeBestAnchor});
- $read_tree_upstream->($cl->{MergeBestAnchor});
- read_tree_debian($cltree);
+ $read_tree_debian->($cltree);
@parents = map { $_->{Breakwater} } @{ $cl->{Parents} };
} elsif ($method eq 'MergeMergeSeries') {
- print "Running merge resolution for $cl->{CommitId}...\n";
- $build = merge_series
- $build, $cl->{MergeWreckNotes},
- $cl->{MergeInterchangeBaseInfo},
- @{ $cl->{Parents} };
+ my $cachehit = reflog_cache_lookup
+ $merge_cache_ref, "vanilla-merge $cl->{CommitId}";
+ if ($cachehit) {
+ print "Using supplied resolution for $cl->{CommitId}...\n";
+ $build = $cachehit;
+ $mwrecknote->('cached-resolution', $build);
+ } else {
+ print "Running merge resolution for $cl->{CommitId}...\n";
+ $mwrecknote->('new-base', $build);
+ $build = merge_series
+ $build, $cl->{MergeWreckNotes},
+ $cl->{MergeInterchangeBaseInfo},
+ @{ $cl->{Parents} };
+ }
$last_anchor = $cl->{MergeBestAnchor};
# Check for mismerges:
printdebug "WALK REWRITING NOW cl=$cl procd=$procd\n";
}
}
- my $newtree = cmdoutput @git, qw(write-tree);
- my $ch = $cl->{Hdr};
- $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
- $ch =~ s{^parent .*\n}{}mg;
- $ch =~ s{(?=^author)}{
- join '', map { "parent $_\n" } @parents
- }me or confess "$ch ?";
if ($rewriting) {
- $ch =~ s{^committer .*$}{$committer_authline}m
- or confess "$ch ?";
+ read_tree_upstream $want_upstream, 0, $want_debian;
+
+ my $newtree = cmdoutput @git, qw(write-tree);
+ my $ch = $cl->{Hdr};
+ $ch =~ s{^tree .*}{tree $newtree}m or confess "$ch ?";
+ $ch =~ s{^parent .*\n}{}mg;
+ $ch =~ s{(?=^author)}{
+ join '', map { "parent $_\n" } @parents
+ }me or confess "$ch ?";
+ if ($rewriting) {
+ $ch =~ s{^committer .*$}{$committer_authline}m
+ or confess "$ch ?";
+ }
+ my $cf = "$rd/m$rewriting";
+ open CD, ">", $cf or confess $!;
+ print CD $ch, "\n", $cl->{Msg} or confess $!;
+ close CD or confess $!;
+ my @cmd = (@git, qw(hash-object));
+ push @cmd, qw(-w) if $rewriting;
+ push @cmd, qw(-t commit), $cf;
+ my $newcommit = cmdoutput @cmd;
+ confess "$ch ?" unless $rewriting
+ or $newcommit eq $cl->{CommitId};
+ $build = $newcommit;
+ } else {
+ $build = $cl->{CommitId};
+ trees_diff_walk "$want_upstream:", "$build:", sub {
+ my ($n) = @_;
+ no warnings qw(exiting);
+ next if $n eq 'debian/';
+ confess f_ "mismatch %s ?", "@_";
+ };
+ trees_diff_walk "$want_debian:debian", "$build:debian", sub {
+ confess f_ "mismatch %s ?", "@_";
+ };
+ my @old_parents = map { $_->{CommitId} } @{ $cl->{Parents} };
+ confess f_ "mismatch %s != %s ?", "@parents", "@old_parents"
+ unless "@parents" eq "@old_parents";
}
- my $cf = "$rd/m$rewriting";
- open CD, ">", $cf or die $!;
- print CD $ch, "\n", $cl->{Msg} or die $!;
- close CD or die $!;
- my @cmd = (@git, qw(hash-object));
- push @cmd, qw(-w) if $rewriting;
- push @cmd, qw(-t commit), $cf;
- my $newcommit = cmdoutput @cmd;
- confess "$ch ?" unless $rewriting or $newcommit eq $cl->{CommitId};
- $build = $newcommit;
if (grep { $method eq $_ } qw(DgitImportUpstreamUpdate)) {
$last_anchor = $cur;
}
};
my $final_check = get_differs $build, $input;
- die sprintf "internal error %#x %s %s", $final_check, $input, $build
+ confess f_ "internal error %#x %s %s", $final_check, $input, $build
if $final_check & ~D_PAT_ADD;
my @r = ($build, $breakwater, $last_anchor);
sub update_head_postlaunder ($$$) {
my ($old, $tip, $reflogmsg) = @_;
- return if $tip eq $old;
- print "git-debrebase: laundered (head was $old)\n";
+ return if $tip eq $old && !@deferred_updates;
+ print f_ "%s: laundered (head was %s)\n", $us, $old;
update_head $old, $tip, $reflogmsg;
# no tree changes except debian/patches
runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches);
}
sub bail_if_rebasing() {
- fail "you are in the middle of a git-rebase already"
+ fail __ "you are in the middle of a git-rebase already"
if currently_rebasing();
}
sub defaultcmd_rebase () {
push @ARGV, @{ $opt_defaultcmd_interactive // [] };
- my ($tip,$breakwater) = do_launder_head 'launder for rebase';
+ my ($tip,$breakwater) = do_launder_head __ 'launder for rebase';
runcmd @git, qw(rebase), @ARGV, $breakwater if @ARGV;
}
sub cmd_analyse () {
- badusage "analyse does not support any options"
+ badusage __ "analyse does not support any options"
if @ARGV and $ARGV[0] =~ m/^-/;
- badusage "too many arguments to analyse" if @ARGV>1;
+ badusage __ "too many arguments to analyse" if @ARGV>1;
my ($old) = @ARGV;
if (defined $old) {
$old = git_rev_parse $old;
$old = git_rev_parse 'HEAD';
}
my ($dummy,$breakwater) = walk $old, 1,*STDOUT;
- STDOUT->error and die $!;
-}
-
-sub ffq_prev_branchinfo () {
- my $current = git_get_symref();
- return gdr_ffq_prev_branchinfo($current);
+ STDOUT->error and confess $!;
}
sub ffq_check ($;$$) {
# normally $currentval should be HEAD
my ($currentval, $ff, $notff) =@_;
- $ff //= sub { print $_[0] or die $!; };
+ $ff //= sub { print $_[0] or confess $!; };
$notff //= \&snag;
my ($status, $message, $current, $ffq_prev, $gdrlast)
return ($status, $message) unless $status eq 'branch';
my $exists = git_get_ref $ffq_prev;
- return ('exists',"$ffq_prev already exists") if $exists;
+ return ('exists', f_ "%s already exists", $ffq_prev) if $exists;
- return ('not-branch', 'HEAD symref is not to refs/heads/')
+ return ('not-branch', __ 'HEAD symref is not to refs/heads/')
unless $current =~ m{^refs/heads/};
my $branch = $';
return unless length $lrval;
if (is_fast_fwd $lrval, $currentval) {
- $ff->("OK, you are ahead of $lrref\n");
+ $ff->(f_ "OK, you are ahead of %s\n", $lrref);
$checked{$lrref} = 1;
} elsif (is_fast_fwd $currentval, $lrval) {
$checked{$lrref} = -1;
- $notff->('behind', "you are behind $lrref, divergence risk");
+ $notff->('behind', f_ "you are behind %s, divergence risk",
+ $lrref);
} else {
$checked{$lrref} = -1;
- $notff->('diverged', "you have diverged from $lrref");
+ $notff->('diverged', f_ "you have diverged from %s", $lrref);
}
};
'remote push branch');
}
if ($branch =~ m{^dgit/}) {
- $check->("refs/remotes/dgit/$branch", 'remote dgit branch');
+ $check->("refs/remotes/dgit/$branch",
+ __ 'remote dgit branch');
} elsif ($branch =~ m{^master$}) {
- $check->("refs/remotes/dgit/dgit/sid", 'remote dgit branch for sid');
+ $check->("refs/remotes/dgit/dgit/sid",
+ __ 'remote dgit branch for sid');
}
return (undef, undef, $ffq_prev, $gdrlast);
}
push @deferred_updates, "update $ffq_prev $currentval $git_null_obj";
push @deferred_updates, "delete $gdrlast";
- push @deferred_update_messages, "Recorded previous head for preservation";
+ push @deferred_update_messages,
+ __ "Recorded previous head for preservation";
return ('deferred', undef);
}
my ($status, $message) = record_ffq_prev_deferred();
if ($status eq 'deferred' || $status eq 'exists') {
} else {
- snag $status, "could not record ffq-prev: $message";
+ snag $status, f_ "could not record ffq-prev: %s", $message;
snags_maybe_bail();
}
}
my ($status, $message, $current, $ffq_prev, $gdrlast)
= ffq_prev_branchinfo();
if ($status ne 'branch') {
- snag $status, "could not check ffq-prev: $message";
+ snag $status, f_ "could not check ffq-prev: %s", $message;
snags_maybe_bail();
}
my $ffq_prev_commitish = $ffq_prev && git_get_ref $ffq_prev;
# ffq-prev is ahead of us, and the only tree changes it has
# are possibly addition of things in debian/patches/.
# Just wind forwards rather than making a pointless pseudomerge.
- push @deferred_updates,
- "update $gdrlast $ffq_prev_commitish $git_null_obj";
+ record_gdrlast $gdrlast, $ffq_prev_commitish;
update_head_checkout $old_head, $ffq_prev_commitish,
- "stitch (fast forward)";
+ sprintf "stitch (%s)", __ 'fast forward';
return;
}
}
# We make pseudomerges with L as the contributing parent.
# This makes git rev-list --first-parent work properly.
my $new_head = make_commit [ $old_head, $ffq_prev ], [
- 'Declare fast forward / record previous work',
+ # we translate this against the time when this same code is
+ # used outside Debian, for downstreams and users
+ (__ 'Declare fast forward / record previous work'),
"[git-debrebase pseudomerge: $prose]",
];
- push @deferred_updates, "update $gdrlast $new_head $git_null_obj";
+ record_gdrlast $gdrlast, $new_head;
update_head $old_head, $new_head, "stitch: $prose";
}
my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
if (!$ffq_prev_commitish) {
- fail "No ffq-prev to stitch." unless $opt_noop_ok;
+ fail __ "No ffq-prev to stitch." unless $opt_noop_ok;
return;
}
my $dangling_head = get_head();
my @tried;
$new_upstream = upstream_commitish_search $upstream_version, \@tried;
if (!length $new_upstream) {
- fail "Could not determine appropriate upstream commitish.\n".
- " (Tried these tags: @tried)\n".
- " Check version, and specify upstream commitish explicitly.";
+ fail f_
+ "Could not determine appropriate upstream commitish.\n".
+ " (Tried these tags: %s)\n".
+ " Check version, and specify upstream commitish explicitly.",
+ "@tried";
}
}
$new_upstream = git_rev_parse $new_upstream;
my %pieces;
- badusage "need NEW-VERSION [UPS-COMMITTISH]" unless @ARGV >= 1;
+ badusage __ "need NEW-VERSION [UPS-COMMITTISH]" unless @ARGV >= 1;
# parse args - low commitment
my $spec_version = shift @ARGV;
my $new_version = (new Dpkg::Version $spec_version, check => 1);
- fail "bad version number \`$spec_version'" unless defined $new_version;
+ fail f_ "bad version number \`%s'", $spec_version
+ unless defined $new_version;
if ($new_version->is_native()) {
$new_version = (new Dpkg::Version "$spec_version-1", check => 1);
}
my ($n, @x) = @_; # may be ''
my $pc = $pieces{$n} //= {
Name => $n,
- Desc => ($n ? "upstream piece \`$n'" : "upstream (main piece"),
+ Desc => ($n ? (f_ "upstream piece \`%s'", $n)
+ : (__ "upstream (main piece")),
};
while (my $k = shift @x) { $pc->{$k} = shift @x; }
$pc;
while (@ARGV && $ARGV[0] !~ m{^-}) {
my $n = shift @ARGV;
- badusage "for each EXTRA-UPS-NAME need EXTRA-UPS-COMMITISH"
+ badusage __ "for each EXTRA-UPS-NAME need EXTRA-UPS-COMMITISH"
unless @ARGV && $ARGV[0] !~ m{^-};
my $c = git_rev_parse shift @ARGV;
- die unless $n =~ m/^$extra_orig_namepart_re$/;
+ confess unless $n =~ m/^$extra_orig_namepart_re$/;
$newpiece->($n, New => $c);
}
my $old_upstream;
if (!$old_anchor_cl->{OrigParents}) {
snag 'anchor-treated',
- 'old anchor is recognised due to --anchor, cannot check upstream';
+ __ 'old anchor is recognised due to --anchor, cannot check upstream';
} else {
$old_upstream = parsecommit
$old_anchor_cl->{OrigParents}[0]{CommitId};
my $old_n_parents = scalar @{ $old_upstream->{Parents} };
if ($old_n_parents != @oldpieces &&
$old_n_parents != @oldpieces + 1) {
- snag 'upstream-confusing', sprintf
+ snag 'upstream-confusing', f_
"previous upstream combine %s".
" mentions %d pieces (each implying one parent)".
" but has %d parents".
(scalar @oldpieces),
$old_n_parents;
} elsif ($oldpieces[0] ne '.') {
- snag 'upstream-confusing', sprintf
+ snag 'upstream-confusing', f_
"previous upstream combine %s".
" first piece is not \`.'",
$oldpieces[0];
}
}
} else {
- snag 'upstream-confusing',
- "previous upstream $old_upstream->{CommitId} is from".
- " git-debrebase but not an \`upstream-combine' commit";
+ snag 'upstream-confusing', f_
+ "previous upstream %s is from".
+ " git-debrebase but not an \`upstream-combine' commit",
+ $old_upstream->{CommitId};
}
}
# we have complained already
} elsif (!$pc->{Old}) {
snag 'upstream-new-piece',
- "introducing upstream piece \`$pc->{Name}'";
+ f_ "introducing upstream piece \`%s'", $pc->{Name};
} elsif (!$pc->{New}) {
snag 'upstream-rm-piece',
- "dropping upstream piece \`$pc->{Name}'";
+ f_ "dropping upstream piece \`%s'", $pc->{Name};
} elsif (!is_fast_fwd $pc->{Old}, $pc->{New}) {
snag 'upstream-not-ff',
- "not fast forward: $pc->{Name} $pc->{Old}..$pc->{New}";
+ f_ "not fast forward: %s %s",
+ $pc->{Name}, "$pc->{Old}..$pc->{New}";
}
}
"[git-debrebase anchor: new upstream $new_upstream_version, merge]",
];
- my $clogsignoff = cmdoutput qw(git show),
- '--pretty=format:%an <%ae> %aD',
- $new_bw;
-
# Now we have to add a changelog stanza so the Debian version
- # is right.
- die if unlink "debian";
- die $! unless $!==ENOENT or $!==ENOTEMPTY;
- unlink "debian/changelog" or $!==ENOENT or die $!;
- mkdir "debian" or die $!;
- open CN, ">", "debian/changelog" or die $!;
- my $oldclog = git_cat_file ":debian/changelog";
- $oldclog =~ m/^($package_re) \(\S+\) / or
- fail "cannot parse old changelog to get package name";
- my $p = $1;
- print CN <<END, $oldclog or die $!;
-$p ($new_version) UNRELEASED; urgency=medium
-
- * Update to new upstream version $new_upstream_version.
-
- -- $clogsignoff
-
-END
- close CN or die $!;
+ # is right. We use debchange to do this. Invoking debchange
+ # here is a bit fiddly because it has a lot of optional
+ # exciting behaviours, some of which will break stuff, and
+ # some of which won't work in a playtree.
+
+ # Make debchange use git's idea of the user's identity.
+ # That way, if the user never uses debchange et al, configuring
+ # git is enough.
+ my $usetup = sub {
+ my ($e, $k) = @_;
+ my $v = cfg $k, 1;
+ defined $v or return;
+ $ENV{$e} = $v;
+ };
+ $usetup->('DEBEMAIL', 'user.email');
+ $usetup->('DEBFULLNAME', 'user.name');
+
+ my @dch = (qw(debchange
+ --allow-lower-version .*
+ --no-auto-nmu
+ --preserve
+ --vendor=Unknown-Vendor
+ --changelog debian/changelog
+ --check-dirname-level 0
+ --release-heuristic=changelog
+ -v), $new_version,
+ "Update to new upstream version $new_upstream_version.");
+
+ runcmd @git, qw(checkout -q debian/changelog);
+ runcmd @dch;
runcmd @git, qw(update-index --add --replace), 'debian/changelog';
# Now we have the final new breakwater branch in the index
$new_bw = make_commit [ $new_bw ],
[ "Update changelog for new upstream $new_upstream_version",
- "[git-debrebase: new upstream $new_upstream_version, changelog]",
+ "[git-debrebase changelog: new upstream $new_upstream_version]",
];
};
badusage "no arguments allowed" if @ARGV;
my ($status, $msg) = record_ffq_prev_deferred();
if ($status eq 'exists' && $opt_noop_ok) {
- print "Previous head already recorded\n" or die $!;
+ print __ "Previous head already recorded\n" or confess $!;
} elsif ($status eq 'deferred') {
run_deferred_updates 'record-ffq-prev';
} else {
- fail "Could not preserve: $msg";
+ fail f_ "Could not preserve: %s", $msg;
}
}
sub cmd_anchor () {
- badusage "no arguments allowed" if @ARGV;
+ badusage __ "no arguments allowed" if @ARGV;
my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
- print "$bw\n" or die $!;
+ print "$anchor\n" or confess $!;
}
sub cmd_breakwater () {
- badusage "no arguments allowed" if @ARGV;
+ badusage __ "no arguments allowed" if @ARGV;
my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
- print "$bw\n" or die $!;
+ print "$bw\n" or confess $!;
}
sub cmd_status () {
- badusage "no arguments allowed" if @ARGV;
+ badusage __ "no arguments allowed" if @ARGV;
# todo: gdr status should print divergence info
# todo: gdr status should print upstream component(s) info
$newest //= $oldest;
};
my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'),
- sub { $note->(1, 'branch contains furniture (not laundered)', @_); },
- sub { $note->(2, 'branch is unlaundered', @_); },
- sub { $note->(3, 'branch needs laundering', @_); },
- sub { $note->(4, 'branch not in git-debrebase form', @_); };
+ sub { $note->(1, __ 'branch contains furniture (not laundered)',@_); },
+ sub { $note->(2, __ 'branch is unlaundered', @_); },
+ sub { $note->(3, __ 'branch needs laundering', @_); },
+ sub { $note->(4, __ 'branch not in git-debrebase form', @_); };
my $prcommitinfo = sub {
my ($cid) = @_;
- flush STDOUT or die $!;
+ flush STDOUT or confess $!;
runcmd @git, qw(--no-pager log -n1),
'--pretty=format: %h %s%n',
$cid;
};
- print "current branch contents, in git-debrebase terms:\n";
+ print __ "current branch contents, in git-debrebase terms:\n";
if (!$oldest->{Badness}) {
- print " branch is laundered\n";
+ print __ " branch is laundered\n";
} else {
print " $oldest->{OurMsg}\n";
my $printed = '';
my $prab = sub {
my ($cid, $what) = @_;
if (!defined $cid) {
- print " $what is not well-defined\n";
+ print f_ " %s is not well-defined\n", $what;
} else {
print " $what\n";
$prcommitinfo->($cid);
}
};
- print "key git-debrebase commits:\n";
- $prab->($anchor, 'anchor');
- $prab->($bw, 'breakwater');
+ print __ "key git-debrebase commits:\n";
+ $prab->($anchor, __ 'anchor');
+ $prab->($bw, __ 'breakwater');
my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
ffq_prev_branchinfo();
- print "branch and ref status, in git-debrebase terms:\n";
+ print __ "branch and ref status, in git-debrebase terms:\n";
if ($ffq_msg) {
print " $ffq_msg\n";
} else {
$ffq_prev = git_get_ref $ffq_prev;
$gdrlast = git_get_ref $gdrlast;
if ($ffq_prev) {
- print " unstitched; previous tip was:\n";
+ print __ " unstitched; previous tip was:\n";
$prcommitinfo->($ffq_prev);
} elsif (!$gdrlast) {
- print " stitched? (no record of git-debrebase work)\n";
+ print __ " stitched? (no record of git-debrebase work)\n";
} elsif (is_fast_fwd $gdrlast, 'HEAD') {
- print " stitched\n";
+ print __ " stitched\n";
} else {
- print " not git-debrebase (diverged since last stitch)\n"
+ print __ " not git-debrebase (diverged since last stitch)\n"
}
}
- print "you are currently rebasing\n" if currently_rebasing();
+ print __ "you are currently rebasing\n" if currently_rebasing();
}
sub cmd_stitch () {
my $prose = 'stitch';
getoptions("stitch",
'prose=s', \$prose);
- badusage "no arguments allowed" if @ARGV;
+ badusage __ "no arguments allowed" if @ARGV;
do_stitch $prose, 0;
}
-sub cmd_prepush () { cmd_stitch(); }
+sub cmd_prepush () {
+ $opt_noop_ok = 1;
+ cmd_stitch();
+}
sub cmd_quick () {
- badusage "no arguments allowed" if @ARGV;
- do_launder_head 'launder for git-debrebase quick';
+ badusage __ "no arguments allowed" if @ARGV;
+ do_launder_head __ 'launder for git-debrebase quick';
do_stitch 'quick';
}
sub cmd_conclude () {
my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
if (!$ffq_prev_commitish) {
- fail "No ongoing git-debrebase session." unless $opt_noop_ok;
+ fail __ "No ongoing git-debrebase session." unless $opt_noop_ok;
return;
}
my $dangling_head = get_head();
badusage "no arguments allowed" if @ARGV;
- do_launder_head 'launder for git-debrebase quick';
+ do_launder_head __ 'launder for git-debrebase quick';
do_stitch 'quick';
}
sub cmd_scrap () {
if (currently_rebasing()) {
runcmd @git, qw(rebase --abort);
+ push @deferred_updates, 'verify HEAD HEAD';
+ # noop, but stops us complaining that scrap was a noop
}
+ badusage __ "no arguments allowed" if @ARGV;
my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
- if (!$ffq_prev_commitish) {
- fail "No ongoing git-debrebase session." unless $opt_noop_ok;
+ my $scrapping_head;
+ if ($ffq_prev_commitish) {
+ $scrapping_head = get_head();
+ push @deferred_updates,
+ "update $gdrlast $ffq_prev_commitish $git_null_obj",
+ "update $ffq_prev $git_null_obj $ffq_prev_commitish";
+ }
+ if (git_get_ref $merge_cache_ref) {
+ push @deferred_updates,
+ "delete $merge_cache_ref";
+ }
+ if (!@deferred_updates) {
+ fail __ "No ongoing git-debrebase session." unless $opt_noop_ok;
finish 0;
}
- my $scrapping_head = get_head();
- badusage "no arguments allowed" if @ARGV;
- push @deferred_updates,
- "update $gdrlast $ffq_prev_commitish $git_null_obj",
- "update $ffq_prev $git_null_obj $ffq_prev_commitish";
snags_maybe_bail();
- update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap";
+ if ($scrapping_head) {
+ update_head_checkout $scrapping_head, $ffq_prev_commitish, "scrap";
+ } else {
+ run_deferred_updates "scrap";
+ }
}
sub make_patches_staged ($) {
# laundered.
my ($secret_head, $secret_bw, $last_anchor) = walk $head;
fresh_workarea();
+ my $any;
in_workarea sub {
- gbp_pq_export 'bw', $secret_bw, $secret_head;
+ $any = gbp_pq_export 'bw', $secret_bw, $secret_head;
};
+ return $any;
}
sub make_patches ($) {
my ($head) = @_;
keycommits $head, 0, \&snag;
- make_patches_staged $head;
+ my $any = make_patches_staged $head;
my $out;
in_workarea sub {
- my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/);
+ my $ptree = !$any ? undef :
+ cmdoutput @git, qw(write-tree --prefix=debian/patches/);
runcmd @git, qw(read-tree), $head;
- read_tree_subdir 'debian/patches', $ptree;
+ if ($ptree) {
+ read_tree_subdir 'debian/patches', $ptree;
+ } else {
+ rm_subdir_cached 'debian/patches';
+ }
$out = make_commit [$head], [
- 'Commit patch queue (exported by git-debrebase)',
- '[git-debrebase: export and commit patches]',
+ (__ 'Commit patch queue (exported by git-debrebase)'),
+ '[git-debrebase make-patches: export and commit patches]',
];
};
return $out;
my $opt_quiet_would_amend;
getoptions("make-patches",
'quiet-would-amend!', \$opt_quiet_would_amend);
- badusage "no arguments allowed" if @ARGV;
+ badusage __ "no arguments allowed" if @ARGV;
bail_if_rebasing();
my $old_head = get_head();
my $new = make_patches $old_head;
my $d = get_differs $old_head, $new;
if ($d == 0) {
- fail "No (more) patches to export." unless $opt_noop_ok;
+ fail __ "No (more) patches to export." unless $opt_noop_ok;
return;
} elsif ($d == D_PAT_ADD) {
snags_maybe_bail();
update_head_checkout $old_head, $new, 'make-patches';
} else {
- print STDERR failmsg
+ print STDERR failmsg f_
"Patch export produced patch amendments".
- " (abandoned output commit $new).".
- " Try laundering first."
+ " (abandoned output commit %s).".
+ " Try laundering first.",
+ $new
unless $opt_quiet_would_amend;
finish 7;
}
}
+sub check_series_has_all_patches ($) {
+ my ($head) = @_;
+ my $seriesfn = 'debian/patches/series';
+ my ($dummy, $series) = git_cat_file "$head:$seriesfn",
+ [qw(blob missing)];
+ $series //= '';
+ my %series;
+ our $comments_snagged;
+ foreach my $f (grep /\S/, grep {!m/^\s\#/} split /\n/, $series) {
+ if ($f =~ m/^\s*\#/) {
+ snag 'series-comments', f_
+ "%s contains comments, which will be discarded",
+ $seriesfn
+ unless $comments_snagged++;
+ next;
+ }
+ fail f_ "patch %s repeated in %s !", $f, $seriesfn if $series{$f}++;
+ }
+ foreach my $patchfile (get_tree "$head:debian/patches", 1,1) {
+ my ($f,$i) = @$patchfile;
+ next if $series{$f};
+ next if $f eq 'series';
+ snag 'unused-patches', f_
+ "Unused patch file %s will be discarded", $f;
+ }
+}
+
+sub begin_convert_from () {
+ my $head = get_head();
+ my ($ffqs, $ffqm, $symref, $ffq_prev, $gdrlast) = ffq_prev_branchinfo();
+
+ fail __ "ffq-prev exists, this is already managed by git-debrebase!"
+ if $ffq_prev && git_get_ref $ffq_prev;
+
+ my $gdrlast_obj = $gdrlast && git_get_ref $gdrlast;
+ snag 'already-converted', __
+ "ahead of debrebase-last, this is already managed by git-debrebase!"
+ if $gdrlast_obj && is_fast_fwd $gdrlast_obj, $head;
+ return ($head, { LastRef => $gdrlast, LastObj => $gdrlast_obj });
+}
+
+sub complete_convert_from ($$$$) {
+ my ($old_head, $new_head, $gi, $mrest) = @_;
+ ffq_check $new_head;
+ record_gdrlast $gi->{LastRef}, $new_head, $gi->{LastObj}
+ if $gi->{LastRef};
+ snags_maybe_bail();
+ update_head_checkout $old_head, $new_head, $mrest;
+}
+
sub cmd_convert_from_gbp () {
- badusage "want only 1 optional argument, the upstream git commitish"
+ badusage __ "want only 1 optional argument, the upstream git commitish"
unless @ARGV<=1;
my $clogp = parsechangelog();
my $version = $clogp->{'Version'}
- // die "missing Version from changelog";
+ // fail __ "missing Version from changelog\n";
my ($upstream_spec) = @ARGV;
my $upstream =
resolve_upstream_version($upstream_spec, $upstream_version);
- my $old_head = get_head();
+ my ($old_head, $gdrlastinfo) = begin_convert_from();
my $upsdiff = get_differs $upstream, $old_head;
if ($upsdiff & D_UPS) {
runcmd @git, qw(--no-pager diff --stat),
$upstream, $old_head,
qw( -- :!/debian :/);
- fail <<END;
-upstream ($upstream_spec) and HEAD are not
+ fail f_ <<END, $upstream_spec, $upstream_spec;
+upstream (%s) and HEAD are not
identical in upstream files. See diffstat above, or run
- git diff $upstream_spec HEAD -- :!/debian :/
+ git diff %s HEAD -- :!/debian :/
END
}
if (!is_fast_fwd $upstream, $old_head) {
snag 'upstream-not-ancestor',
- "upstream ($upstream) is not an ancestor of HEAD";
+ f_ "upstream (%s) is not an ancestor of HEAD", $upstream;
} else {
my $wrong = cmdoutput
(@git, qw(rev-list --ancestry-path), "$upstream..HEAD",
qw(-- :/ :!/debian));
if (length $wrong) {
- snag 'unexpected-upstream-changes',
- "history between upstream ($upstream) and HEAD contains direct changes to upstream files - are you sure this is a gbp (patches-unapplied) branch?";
- print STDERR "list expected changes with: git log --stat --ancestry-path $upstream_spec..HEAD -- :/ ':!/debian'\n";
+ snag 'unexpected-upstream-changes', f_
+ "history between upstream (%s) and HEAD contains direct changes to upstream files - are you sure this is a gbp (patches-unapplied) branch?",
+ $upstream;
+ print STDERR f_ "list expected changes with: %s\n",
+ "git log --stat --ancestry-path $upstream_spec..HEAD -- :/ ':!/debian'";
}
}
if ((git_cat_file "$upstream:debian")[0] ne 'missing') {
snag 'upstream-has-debian',
- "upstream ($upstream) contains debian/ directory";
+ f_ "upstream (%s) contains debian/ directory", $upstream;
}
+ check_series_has_all_patches $old_head;
+
my $previous_dgit_view = eval {
my @clogcmd = qw(dpkg-parsechangelog --format rfc822 -n2);
my ($lvsn, $suite);
$suite = $stz->{Distribution};
last;
};
- die "neither of the first two changelog entries are released\n"
+ die __ "neither of the first two changelog entries are released\n"
unless defined $lvsn;
print "last finished-looking changelog entry: ($lvsn) $suite\n";
my $mtag_pat = debiantag_maintview $lvsn, '*';
my $mtag = cmdoutput @git, qw(describe --always --abbrev=0 --match),
$mtag_pat;
- die "could not find suitable maintainer view tag $mtag_pat\n"
- unless $mtag_pat =~ m{/};
+ die f_ "could not find suitable maintainer view tag %s\n", $mtag_pat
+ unless $mtag =~ m{/};
is_fast_fwd $mtag, 'HEAD' or
- die "HEAD is not FF from maintainer tag $mtag!";
+ die f_ "HEAD is not FF from maintainer tag %s!", $mtag;
my $dtag = "archive/$mtag";
+ git_get_ref "refs/tags/$dtag" or
+ die f_ "dgit view tag %s not found\n", $dtag;
is_fast_fwd $mtag, $dtag or
- die "dgit view tag $dtag is not FF from maintainer tag $mtag";
- print "will stitch in dgit view, $dtag\n";
+ die f_ "dgit view tag %s is not FF from maintainer tag %s\n",
+ $dtag, $mtag;
+ print f_ "will stitch in dgit view, %s\n", $dtag;
git_rev_parse $dtag;
};
if (!$previous_dgit_view) {
$@ =~ s/^\n+//;
chomp $@;
- print STDERR "cannot stitch in dgit view: $@\n";
+ print STDERR f_ <<END, "$@";
+Cannot confirm dgit view: %s
+Failed to stitch in dgit view (see messages above).
+dgit --overwrite will be needed on the first dgit push after conversion.
+END
}
snags_maybe_bail_early();
}
};
- ffq_check $work;
- snags_maybe_bail();
- update_head_checkout $old_head, $work, 'convert-from-gbp';
+ complete_convert_from $old_head, $work, $gdrlastinfo, 'convert-from-gbp';
+ print f_ <<END, $us or confess $!;
+%s: converted from patched-unapplied (gbp) branch format, OK
+END
}
sub cmd_convert_to_gbp () {
badusage "no arguments allowed" if @ARGV;
my $head = get_head();
my (undef, undef, undef, $ffq, $gdrlast) = ffq_prev_branchinfo();
- keycommits $head, 0;
- my $out;
- make_patches_staged $head;
- in_workarea sub {
- $out = make_commit ['HEAD'], [
- 'Commit patch queue (converted from git-debrebase format)',
- '[git-debrebase convert-to-gbp: commit patches]',
- ];
- };
+ my ($anchor, $breakwater) = keycommits $head, 0;
+ my $out = $breakwater;
+ my $any = make_patches_staged $head;
+ if ($any) {
+ in_workarea sub {
+ $out = make_commit [$out], [
+ 'Commit patch queue (converted from git-debrebase format)',
+ '[git-debrebase convert-to-gbp: commit patches]',
+ ];
+ };
+ } else {
+ # in this case, it can be fast forward
+ $out = $head;
+ }
if (defined $ffq) {
push @deferred_updates, "delete $ffq";
push @deferred_updates, "delete $gdrlast";
}
snags_maybe_bail();
update_head_checkout $head, $out, "convert to gbp (v0)";
- print <<END or die $!;
-git-debrebase: converted to git-buildpackage branch format
-git-debrebase: WARNING: do not now run "git-debrebase" any more
-git-debrebase: WARNING: doing so would drop all upstream patches!
+ print f_ <<END, $us,$us,$us or confess $!;
+%s: converted to git-buildpackage branch format
+%s: WARNING: do not now run "git-debrebase" any more
+%s: WARNING: doing so would drop all upstream patches!
END
}
'origs!', \$do_origs,
'tags!', \$do_tags,
'always-convert-anyway!', \$always);
- fail "takes 1 optional argument, the upstream commitish" if @ARGV>1;
+ fail __ "takes 1 optional argument, the upstream commitish" if @ARGV>1;
my @upstreams;
my $spec = shift @ARGV;
my $commit = git_rev_parse "$spec^{commit}";
push @upstreams, { Commit => $commit,
- Source => "$ARGV[0], from command line",
+ Source => (f_ "%s, from command line", $ARGV[0]),
Only => 1,
};
}
- my $head = get_head();
+ my ($head, $gdrlastinfo) = begin_convert_from();
if (!$always) {
my $troubles = 0;
keycommits $head, sub{}, sub{}, $trouble, $trouble;
printdebug "troubles=$troubles\n";
if (!$troubles) {
- print STDERR <<END;
-$us: Branch already seems to be in git-debrebase format!
-$us: --always-convert-anyway would do the conversion operation anyway
-$us: but is probably a bad idea. Probably, you wanted to do nothing.
+ print STDERR f_ <<END, $us,$us,$us;
+%s: Branch already seems to be in git-debrebase format!
+%s: --always-convert-anyway would do the conversion operation anyway
+%s: but is probably a bad idea. Probably, you wanted to do nothing.
END
- fail "Branch already in git-debrebase format." unless $opt_noop_ok;
+ fail __ "Branch already in git-debrebase format."
+ unless $opt_noop_ok;
finish 0;
}
}
+ check_series_has_all_patches $head;
+
snags_maybe_bail_early();
my $version = upstreamversion $clogp->{Version};
- print STDERR "Considering possible commits corresponding to upstream:\n";
+ print STDERR __
+ "Considering possible commits corresponding to upstream:\n";
if (!@upstreams) {
if ($do_tags) {
my @tried;
my $ups_tag = upstream_commitish_search $version, \@tried;
if ($ups_tag) {
- my $this = "git tag $tried[-1]";
+ my $this = f_ "git tag %s", $tried[-1];
push @upstreams, { Commit => $ups_tag,
Source => $this,
};
} else {
- printf STDERR
+ print STDERR f_
" git tag: no suitable tag found (tried %s)\n",
"@tried";
}
# we do a quick check to see if there are plausible origs
my $something=0;
if (!opendir BPD, $bpd) {
- die "$bpd: opendir: $!" unless $!==ENOENT;
+ die f_ "opendir build-products-dir %s: %s", $bpd, $!
+ unless $!==ENOENT;
} else {
while ($!=0, my $f = readdir BPD) {
next unless is_orig_file_of_p_v $f, $p, $version;
- printf STDERR
+ print STDERR f_
" orig: found what looks like a .orig, %s\n",
"$bpd/$f";
$something=1;
last;
}
- die "read $bpd: $!" if $!;
+ confess "read $bpd: $!" if $!;
closedir BPD;
}
if ($something) {
END
This includes the contents of the .orig(s), minus any debian/ directory.
-[git-debrebase import-from-dgit-view upstream-import-convert: $version]
+[git-debrebase convert-from-dgit-view upstream-import-convert: $version]
END
];
push @upstreams, { Commit => $ups_synth,
};
}
} else {
- printf STDERR
+ print STDERR f_
" orig: no suitable origs found (looked for %s in %s)\n",
"${p}_".(stripeoch $version)."...", $bpd;
}
my $some_patches = stat_exists 'debian/patches/series';
- print STDERR "Evaluating possible commits corresponding to upstream:\n";
+ print STDERR __
+ "Evaluating possible commits corresponding to upstream:\n";
my $result;
foreach my $u (@upstreams) {
'git-debrebase convert-from-dgit-view: drop upstream changes from breakwater',
"Drop upstream changes, and delete debian/patches, as part of converting\n".
"to git-debrebase format. Upstream changes will appear as commits.",
- '[git-debrebase convert-from-dgit-view: drop patches from tree]'
+ '[git-debrebase convert-from-dgit-view drop-patches]'
];
}
$work = make_commit [ $work, $u->{Commit} ], [
}
my $r = system @gbp_cmd;
if ($r) {
- printf STDERR
+ print STDERR f_
" %s: couldn't apply patches: gbp pq %s",
$u->{Source}, waitstatusmsg();
return;
my $work = git_rev_parse qw(HEAD);
my $diffout = cmdoutput @git, qw(diff-tree --stat HEAD), $work;
if (length $diffout) {
- print STDERR
- " $u->{Source}: applying patches gives different tree\n";
+ print STDERR f_
+ " %s: applying patches gives different tree\n",
+ $u->{Source};
print STDERR $diffout if $diagnose;
return;
}
}
if (!$result) {
- fail <<END;
+ fail __ <<END;
Could not find or construct a suitable upstream commit.
Rerun adding --diagnose after convert-from-dgit-view, or pass a
upstream commmit explicitly or provide suitable origs.
END
}
- printf STDERR "Yes, will base new branch on %s\n", $result->{Source};
+ print STDERR f_ "Yes, will base new branch on %s\n", $result->{Source};
- ffq_check $result->{Result};
- snags_maybe_bail();
- update_head_checkout $head, $result->{Result},
+ complete_convert_from $head, $result->{Result}, $gdrlastinfo,
'convert-from-dgit-view';
}
+sub cmd_forget_was_ever_debrebase () {
+ badusage __ "forget-was-ever-debrebase takes no further arguments"
+ if @ARGV;
+ my ($ffqstatus, $ffq_msg, $current, $ffq_prev, $gdrlast) =
+ ffq_prev_branchinfo();
+ fail f_ "Not suitable for recording git-debrebaseness anyway: %s",
+ $ffq_msg
+ if defined $ffq_msg;
+ push @deferred_updates, "delete $ffq_prev";
+ push @deferred_updates, "delete $gdrlast";
+ snags_maybe_bail();
+ run_deferred_updates "forget-was-ever-debrebase";
+}
+
+sub cmd_record_resolved_merge () {
+ badusage "record-resolved-merge takes no further arguments" if @ARGV;
+ # MERGE-TODO needs documentation
+ my $new = get_head();
+ my $method;
+
+ print "Checking how you have resolved the merge problem\n";
+ my $nope = sub { print "Not $method: @_"; 0; };
+
+ my $maybe = sub { print "Seems to be $method.\n"; };
+ my $yes = sub {
+ my ($key, $ref) = @_;
+ reflog_cache_insert $merge_cache_ref, $key, $ref;
+ print "OK. You can switch branches and try git-debrebase again.\n";
+ 1;
+ };
+
+ fresh_workarea 'merge';
+ sub {
+ $method = 'vanilla-merge patchqueue';
+ my $vanilla = git_get_ref "$wrecknoteprefix/vanilla-merge";
+ $vanilla or return $nope->("wreckage was not of vanilla-merge");
+ foreach my $lr (qw(left right)) {
+ my $n = "$wrecknoteprefix/$lr-patchqueue";
+ my $lrpq = git_get_ref $n;
+ $lrpq or return $nope->("wreckage did not contain patchqueues");
+ is_fast_fwd $lrpq, $new or return $nope->("HEAD not ff of $n");
+ }
+ $maybe->();
+ my $newbase = git_get_ref "$wrecknoteprefix/new-base"
+ or die "wreckage element $wrecknoteprefix/new-base missing";
+ my $result = merge_series_patchqueue_convert
+ {}, $newbase, $new;
+ $yes->("vanilla-merge $vanilla", $result);
+ 1;
+ }->() or sub {
+ fail "No resolved merge method seems applicable.\n";
+ }->();
+}
+
sub cmd_downstream_rebase_launder_v0 () {
badusage "needs 1 argument, the baseline" unless @ARGV==1;
my ($base) = @ARGV;
}
}
+setlocale(LC_MESSAGES, "");
+textdomain("git-debrebase");
+
getoptions_main
- ("bad options\n",
+ (__ "bad options\n",
"D+" => \$debuglevel,
'noop-ok', => \$opt_noop_ok,
'f=s' => \@snag_force_opts,
'anchor=s' => \@opt_anchors,
'--dgit=s' => \($dgit[0]),
'force!',
+ 'experimental-merge-resolution!', \$opt_merges,
'-i:s' => sub {
my ($opt,$val) = @_;
- badusage "git-debrebase: no cuddling to -i for git-rebase"
+ badusage f_ "%s: no cuddling to -i for git-rebase", $us
if length $val;
- die if $opt_defaultcmd_interactive; # should not happen
+ confess if $opt_defaultcmd_interactive; # should not happen
$opt_defaultcmd_interactive = [ qw(-i) ];
# This access to @ARGV is excessive familiarity with
# Getopt::Long, but there isn't another sensible
push @$opt_defaultcmd_interactive, @ARGV;
@ARGV=();
},
- 'help' => sub { print $usage_message or die $!; finish 0; },
+ 'help' => sub { print __ $usage_message or confess $!; finish 0; },
);
initdebug('git-debrebase ');
enabledebug if $debuglevel;
-my $toplevel = cmdoutput @git, qw(rev-parse --show-toplevel);
-chdir $toplevel or die "chdir $toplevel: $!";
+changedir_git_toplevel();
$rd = fresh_playground "$playprefix/misc";
$cmdfn =~ y/-/_/;
$cmdfn = ${*::}{"cmd_$cmdfn"};
- $cmdfn or badusage "unknown git-debrebase sub-operation $cmd";
+ $cmdfn or badusage f_ "unknown git-debrebase sub-operation %s", $cmd;
$cmdfn->();
}
~ianmdlvl / dgit.git / blobdiff