git-debrebase: provide record_ffq_prev (no callers yet)

Signed-off-by: Ian Jackson <ijackson@chiark.greenend.org.uk>

diff --git a/git-debrebase b/git-debrebase
index 421a1cb25f3406981e26f498b6bad8840498147d..2f34029a996e3cbeff566806e93789832a67489a 100755 (executable)
--- a/git-debrebase
+++ b/git-debrebase
@@ -844,6 +844,84 @@ sub cmd_analyse () {
     STDOUT->error and die $!;
 }
 
+sub record_ffq_prev () {
+    # => ('status', "message")
+    # 'status' may be
+    #    written          message is undef
+    #    exists
+    #    detached
+    #    weird-symref
+    #    notbranch
+    # if not ff from some branch we should be ff from, is an fproblem
+    # if "written", will have printed something about that to stdout,
+    #   and also some messages about ff checks
+    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 $currentval = get_head();
+
+    my $exists = git_get_ref $ffq_prev;
+    return ('exists',"$ffq_prev already exists") if defined $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") // '*';
+    my %checked;
+
+    my $check = sub {
+       my ($lrref, $desc) = @_;
+       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;
+       } if (is_fast_fwd $currentval, $lrval) {
+           $checked{$lrref} = -1;
+           fproblem 'behind', "you are behind $lrref, divergence risk";
+       } else {
+           $checked{$lrref} = -1;
+           fproblem 'diverged', "you have diverged from $lrref";
+       }
+    };
+
+    my $merge = cfg "branch.$branch.merge";
+    if (defined $merge && $merge =~ m{^refs/heads/}) {
+       my $rhs = $';
+       my $check_remote = sub {
+           my ($remote, $desc) = (@_);
+           return unless defined $remote;
+           $check->("refs/remotes/$remote/$rhs", $desc);
+       };
+       $check_remote->((cfg "branch.$branch.remote"),
+                       'remote fetch/merge branch');
+       $check_remote->((cfg "branch.$branch.pushRemote") //
+                       (cfg "branch.$branch.pushDefault"),
+                       'remote push branch');
+    }
+    if ($branch =~ m{^dgit/}) {
+       $check->("remotes/dgit/$branch", 'remote dgit branch');
+    }
+
+    fproblems_maybe_fail();
+    runcmd @git, qw(update-ref -m), "record current head for preservation",
+       $ffq_prev, $currentval, $git_null_obj;
+    print "Recorded current head for preservation\n" or die $!;
+    return ('written', undef);
+}
+
 sub cmd_new_upstream_v0 () {
     # tree should be clean and this is not checked
     # automatically and unconditionally launders before rebasing