+sub cmd_record_ffq_prev () {
+ 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 $!;
+ } elsif ($status eq 'deferred') {
+ run_deferred_updates 'record-ffq-prev';
+ } else {
+ fail "Could not preserve: $msg";
+ }
+}
+
+sub cmd_anchor () {
+ badusage "no arguments allowed" if @ARGV;
+ my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
+ print "$bw\n" or die $!;
+}
+
+sub cmd_breakwater () {
+ badusage "no arguments allowed" if @ARGV;
+ my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
+ print "$bw\n" or die $!;
+}
+
+sub cmd_status () {
+ badusage "no arguments allowed" if @ARGV;
+
+ my $oldest = [ 0 ];
+ my $newest;
+ my $note = sub {
+ my ($badness, $ourmsg, $snagname, $kcmsg, $cl) = @_;
+ if ($oldest->[0] < $badness) {
+ $oldest = $newest = undef;
+ }
+ $oldest = \@_; # we're walking backwards
+ $newest //= \@_;
+ };
+ 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', @_); };
+
+ my $prcommitinfo = sub {
+ my ($cid) = @_;
+ flush STDOUT or die $!;
+ runcmd @git, qw(--no-pager log -n1),
+ '--pretty=format: %h %s%n',
+ $cid;
+ };
+
+ print "current branch contents, in git-debrebase terms:\n";
+ if (!$oldest->[0]) {
+ print " branch is laundered\n";
+ } else {
+ print " $oldest->[1]\n";
+ my $printed = '';
+ foreach my $info ($oldest, $newest) {
+ my $cid = $info->[4]{CommitId};
+ next if $cid eq $printed;
+ $printed = $cid;
+ print " $info->[3]\n";
+ $prcommitinfo->($cid);
+ }
+ }
+
+ my $prab = sub {
+ my ($cid, $what) = @_;
+ if (!defined $cid) {
+ print " $what is not well-defined\n";
+ } else {
+ print " $what\n";
+ $prcommitinfo->($cid);
+ }
+ };
+ 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";
+ 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";
+ $prcommitinfo->($ffq_prev);
+ } elsif (!$gdrlast) {
+ print " stitched? (no record of git-debrebase work)\n";
+ } elsif (is_fast_fwd $gdrlast, 'HEAD') {
+ print " stitched\n";
+ } else {
+ print " not git-debrebase (diverged since last stitch)\n"
+ }
+ }
+}
+
+sub cmd_stitch () {
+ my $prose = 'stitch';
+ GetOptions('prose=s', \$prose) or die badusage("bad options to stitch");
+ badusage "no arguments allowed" if @ARGV;
+ do_stitch $prose, 0;
+}
+sub cmd_prepush () { cmd_stitch(); }
+
+sub cmd_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;
+ return;
+ }
+ my $dangling_head = get_head();
+
+ badusage "no arguments allowed" if @ARGV;
+ do_launder_head 'launder for git-debrebase quick';
+ do_stitch 'quick';
+}
+
+sub make_patches_staged ($) {
+ my ($head) = @_;
+ # Produces the patches that would result from $head if it were
+ # laundered.
+ my ($secret_head, $secret_bw, $last_anchor) = walk $head;
+ fresh_workarea();
+ in_workarea sub {
+ runcmd @git, qw(checkout -q -b bw), $secret_bw;
+ runcmd @git, qw(checkout -q -b patch-queue/bw), $secret_head;
+ runcmd qw(gbp pq export);
+ runcmd @git, qw(add debian/patches);
+ };
+}
+
+sub make_patches ($) {
+ my ($head) = @_;
+ keycommits $head, 0, \&snag;
+ make_patches_staged $head;
+ my $out;
+ in_workarea sub {
+ my $ptree = cmdoutput @git, qw(write-tree --prefix=debian/patches/);
+ runcmd @git, qw(read-tree), $head;
+ read_tree_subdir 'debian/patches', $ptree;
+ $out = make_commit [$head], [
+ 'Commit patch queue (exported by git-debrebase)',
+ '[git-debrebase: export and commit patches]',
+ ];
+ };
+ return $out;
+}
+
+sub cmd_make_patches () {
+ my $opt_quiet_would_amend;
+ GetOptions('quiet-would-amend!', \$opt_quiet_would_amend)
+ or die badusage("bad options to make-patches");
+ badusage "no arguments allowed" if @ARGV;
+ 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;
+ return;
+ } elsif ($d == D_PAT_ADD) {
+ snags_maybe_bail();
+ update_head_checkout $old_head, $new, 'make-patches';
+ } else {
+ print STDERR failmsg
+ "Patch export produced patch amendments".
+ " (abandoned output commit $new).".
+ " Try laundering first."
+ unless $opt_quiet_would_amend;
+ finish 7;
+ }
+}
+
+sub cmd_convert_from_gbp () {
+ badusage "needs 1 optional argument, the upstream git rev"
+ unless @ARGV<=1;
+ my ($upstream_spec) = @ARGV;
+ $upstream_spec //= 'refs/heads/upstream';
+ my $upstream = git_rev_parse $upstream_spec;
+ my $old_head = get_head();
+
+ my $upsdiff = get_differs $upstream, $old_head;
+ if ($upsdiff & D_UPS) {
+ runcmd @git, qw(--no-pager diff),
+ $upstream, $old_head,
+ qw( -- :!/debian :/);
+ fail "upstream ($upstream_spec) and HEAD are not identical in upstream files";
+ }
+
+ if (!is_fast_fwd $upstream, $old_head) {
+ snag 'upstream-not-ancestor',
+ "upstream ($upstream) is not an ancestor of HEAD";
+ } 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";
+ }
+ }
+
+ if ((git_cat_file "$upstream:debian")[0] ne 'missing') {
+ snag 'upstream-has-debian',
+ "upstream ($upstream) contains debian/ directory";
+ }
+
+ snags_maybe_bail();
+
+ my $work;
+
+ fresh_workarea();
+ in_workarea sub {
+ runcmd @git, qw(checkout -q -b gdr-internal), $old_head;
+ # make a branch out of the patch queue - we'll want this in a mo
+ runcmd qw(gbp pq import);
+ # strip the patches out
+ runcmd @git, qw(checkout -q gdr-internal~0);
+ rm_subdir_cached 'debian/patches';
+ $work = make_commit ['HEAD'], [
+ 'git-debrebase convert-from-gbp: drop patches from tree',
+ 'Delete debian/patches, as part of converting to git-debrebase format.',
+ '[git-debrebase convert-from-gbp: drop patches from tree]'
+ ];
+ # make the anchor merge
+ # the tree is already exactly right
+ $work = make_commit [$work, $upstream], [
+ 'git-debrebase import: declare upstream',
+ 'First breakwater merge.',
+ '[git-debrebase anchor: declare upstream]'
+ ];
+
+ # rebase the patch queue onto the new breakwater
+ runcmd @git, qw(reset --quiet --hard patch-queue/gdr-internal);
+ runcmd @git, qw(rebase --quiet --onto), $work, qw(gdr-internal);
+ $work = git_rev_parse 'HEAD';
+ };
+
+ update_head_checkout $old_head, $work, 'convert-from-gbp';
+}
+
+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]',
+ ];
+ };
+ 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!
+END
+}
+