+sub ffq_prev_branchinfo () {
+ # => ('status', "message", [$current, $ffq_prev, $gdrlast])
+ # 'status' may be
+ # branch message is undef
+ # weird-symref } no $current,
+ # notbranch } no $ffq_prev
+ my $current = git_get_symref();
+ return ('detached', 'detached HEAD') unless defined $current;
+ return ('weird-symref', 'HEAD symref is not to refs/')
+ unless $current =~ m{^refs/};
+ my $ffq_prev = "refs/$ffq_refprefix/$'";
+ my $gdrlast = "refs/$gdrlast_refprefix/$'";
+ printdebug "ffq_prev_branchinfo branch current $current\n";
+ return ('branch', undef, $current, $ffq_prev, $gdrlast);
+}
+
+sub record_ffq_prev_deferred () {
+ # => ('status', "message")
+ # 'status' may be
+ # deferred message is undef
+ # exists
+ # detached
+ # weird-symref
+ # notbranch
+ # if not ff from some branch we should be ff from, is an snag
+ # if "deferred", will have added something about that to
+ # @deferred_update_messages, and also maybe printed (already)
+ # some messages about ff checks
+ my ($status, $message, $current, $ffq_prev, $gdrlast)
+ = ffq_prev_branchinfo();
+ return ($status, $message) unless $status eq 'branch';
+
+ my $currentval = get_head();
+
+ my $exists = git_get_ref $ffq_prev;
+ return ('exists',"$ffq_prev already exists") if $exists;
+
+ return ('not-branch', 'HEAD symref is not to refs/heads/')
+ unless $current =~ m{^refs/heads/};
+ my $branch = $';
+
+ my @check_specs = split /\;/, (cfg "branch.$branch.ffq-ffrefs",1) // '*';
+ my %checked;
+
+ printdebug "ffq check_specs @check_specs\n";
+
+ my $check = sub {
+ my ($lrref, $desc) = @_;
+ printdebug "ffq might check $lrref ($desc)\n";
+ my $invert;
+ for my $chk (@check_specs) {
+ my $glob = $chk;
+ $invert = $glob =~ s{^[!^]}{};
+ last if fnmatch $glob, $lrref;
+ }
+ return if $invert;
+ my $lrval = git_get_ref $lrref;
+ return unless defined $lrval;
+
+ if (is_fast_fwd $lrval, $currentval) {
+ print "OK, you are ahead of $lrref\n" or die $!;
+ $checked{$lrref} = 1;
+ } elsif (is_fast_fwd $currentval, $lrval) {
+ $checked{$lrref} = -1;
+ snag 'behind', "you are behind $lrref, divergence risk";
+ } else {
+ $checked{$lrref} = -1;
+ snag 'diverged', "you have diverged from $lrref";
+ }
+ };
+
+ my $merge = cfg "branch.$branch.merge",1;
+ if (defined $merge and $merge =~ m{^refs/heads/}) {
+ my $rhs = $';
+ printdebug "ffq merge $rhs\n";
+ my $check_remote = sub {
+ my ($remote, $desc) = @_;
+ printdebug "ffq check_remote ".($remote//'undef')." $desc\n";
+ return unless defined $remote;
+ $check->("refs/remotes/$remote/$rhs", $desc);
+ };
+ $check_remote->((scalar cfg "branch.$branch.remote",1),
+ 'remote fetch/merge branch');
+ $check_remote->((scalar cfg "branch.$branch.pushRemote",1) //
+ (scalar cfg "branch.$branch.pushDefault",1),
+ 'remote push branch');
+ }
+ if ($branch =~ m{^dgit/}) {
+ $check->("refs/remotes/dgit/$branch", 'remote dgit branch');
+ } elsif ($branch =~ m{^master$}) {
+ $check->("refs/remotes/dgit/dgit/sid", 'remote dgit branch for sid');
+ }
+
+ snags_maybe_bail();
+
+ push @deferred_updates, "update $ffq_prev $currentval $git_null_obj";
+ push @deferred_updates, "delete $gdrlast";
+ push @deferred_update_messages, "Recorded current head for preservation";
+ return ('deferred', undef);
+}
+
+sub record_ffq_auto () {
+ my ($status, $message) = record_ffq_prev_deferred();
+ if ($status eq 'deferred' || $status eq 'exists') {
+ } else {
+ snag $status, "could not record ffq-prev: $message";
+ snags_maybe_bail();
+ }
+}
+
+sub ffq_prev_info () {
+ # => ($ffq_prev, $gdrlast, $ffq_prev_commitish)
+ my ($status, $message, $current, $ffq_prev, $gdrlast)
+ = ffq_prev_branchinfo();
+ if ($status ne 'branch') {
+ snag $status, "could not check ffq-prev: $message";
+ snags_maybe_bail();
+ }
+ my $ffq_prev_commitish = $ffq_prev && git_get_ref $ffq_prev;
+ return ($ffq_prev, $gdrlast, $ffq_prev_commitish);
+}
+
+sub stitch ($$$$$) {
+ my ($old_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose) = @_;
+
+ push @deferred_updates, "delete $ffq_prev $ffq_prev_commitish";
+
+ if (is_fast_fwd $old_head, $ffq_prev_commitish) {
+ my $differs = get_differs $old_head, $ffq_prev_commitish;
+ unless ($differs & ~D_PAT_ADD) {
+ # 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";
+ update_head_checkout $old_head, $ffq_prev_commitish,
+ "stitch (fast forward)";
+ return;
+ }
+ }
+ fresh_workarea();
+ my $new_head = make_commit [ $old_head, $ffq_prev ], [
+ 'Declare fast forward / record previous work',
+ "[git-debrebase pseudomerge: $prose]",
+ ];
+ push @deferred_updates, "update $gdrlast $new_head $git_null_obj";
+ update_head $old_head, $new_head, "stitch: $prose";
+}
+
+sub do_stitch ($) {
+ my ($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;
+ return;
+ }
+ my $dangling_head = get_head();
+
+ keycommits $dangling_head, \&snag, \&snag, \&snag;
+
+ stitch($dangling_head, $ffq_prev, $gdrlast, $ffq_prev_commitish, $prose);
+}
+