1 files changed, 56 insertions, 23 deletions

diff --git a/git-debrebase b/git-debrebase
index 55fbbd5..4667e8b 100755
--- a/git-debrebase
+++ b/git-debrebase
@@ -494,48 +494,81 @@ sub classify ($) {
     return $unknown->("complex merge");
 }
 
-sub breakwater_of ($;$) {
-    my ($head, $unclean_fproblem_tag) = @_;
-    # $head should be laundered; if not, $unclean_fproblem_tag controls:
-    # if falseish, calls fail; otherwise, calls fproblem and returns undef
-    my $breakwater;
-    my $unclean = sub {
-	my ($why) = @_;
+sub keycommits ($;$$$) {
+    my ($head, $furniture, $unclean, $trouble) = @_;
+    # => ($anchor, $breakwater)
+
+    # $unclean->("unclean-$tagsfx", $msg)
+    # $furniture->("unclean-$tagsfx", $msg)
+    # $dgitimport->("unclean-$tagsfx", $msg)
+    #   is callled for each situation or commit that
+    #   wouldn't be found in a laundered branch
+    # $furniture is forfurniture commits such as might be found on an
+    #   interchange branch (pseudomerge, d/patches, changelog)
+    # $trouble is for things whnich prevent the return of
+    #   anchor and breakwater information; if that is ignored,
+    #   then keycommits returns (undef, undef) instead.
+    #
+    # If a callback is undef, fail is called instead.
+    # If a callback is defined but false, the situation is ignored.
+    # Callbacks may say:
+    #   no warnings qw(exiting); last;
+    # if the answer is no longer wanted.
+
+    my ($anchor, $breakwater);
+    my $clogonly;
+    my $x = sub {
+	my ($cb, $tagsfx, $why) = @_;
 	my $m = "branch needs laundering (run git-debrebase): $why";
-	fail $m unless $unclean_fproblem_tag;
-	fproblem $unclean_fproblem_tag, $m;
-	$breakwater = undef;
-	no warnings qw(exiting);
-	last;
+	fail $m unless defined $cb;
+	return unless $cb;
+	$cb->("unclean-$tagsfx", $why);
     };
     for (;;) {
 	my $cl = classify $head;
 	my $ty = $cl->{Type};
-	if ($ty eq 'Packaging' or
-	    $ty eq 'Changelog') {
+	if ($ty eq 'Packaging') {
+	    $breakwater //= $clogonly;
 	    $breakwater //= $head;
+	} elsif ($ty eq 'Changelog') {
+	    # this is going to count as the tip of the breakwater
+	    # only if it has no upstream stuff before it
+	    $clogonly //= $head;
 	} elsif ($ty eq 'Anchor' or
 		 $ty eq 'TreatAsAnchor' or
 		 $ty eq 'BreakwaterStart') {
+	    $anchor = $head;
+	    $breakwater //= $clogonly;
 	    $breakwater //= $head;
 	    last;
 	} elsif ($ty eq 'Upstream') {
-	    $unclean->("packaging change ($breakwater)".
-		       " follows upstream change (eg $head)")
+	    $x->($unclean, 'ordering',
+ "packaging change ($breakwater) follows upstream change (eg $head)")
 		if defined $breakwater;
+	    $clogonly = undef;
+	    $breakwater = undef;
 	} elsif ($ty eq 'Mixed') {
-	    $unclean->('found mixed upstream/packaging commit ($head)');
+	    $x->($unclean, 'mixed',
+		 'found mixed upstream/packaging commit ($head)');
+	    $clogonly = undef;
+	    $breakwater = undef;
 	} elsif ($ty eq 'Pseudomerge' or
 		 $ty eq 'AddPatches') {
-	    $unclean->("found interchange conversion commit ($ty, $head)");
+	    $x->($furniture, (lc $ty),
+		 "found interchange bureaucracy commit ($ty, $head)");
 	} elsif ($ty eq 'DgitImportUnpatched') {
-	    $unclean->("found dgit dsc import ($head)");
+	    $x->($trouble, 'dgitimport',
+		 "found dgit dsc import ($head)");
+	    $breakwater = undef;
+	    $anchor = undef;
+	    no warnings qw(exiting);
+	    last;
 	} else {
 	    fail "found unprocessable commit, cannot cope: $head; $cl->{Why}";
 	}
 	$head = $cl->{Parents}[0]{CommitId};
     }
-    return $breakwater;
+    return ($anchor, $breakwater);
 }
 
 sub walk ($;$$);
@@ -1193,7 +1226,7 @@ sub cmd_record_ffq_prev () {
 
 sub cmd_breakwater () {
     badusage "no arguments allowed" if @ARGV;
-    my $bw = breakwater_of git_rev_parse 'HEAD';
+    my ($anchor, $bw) = keycommits +(git_rev_parse 'HEAD'), 0,0;
     print "$bw\n" or die $!;
 }
 
@@ -1214,7 +1247,7 @@ sub cmd_stitch () {
     }
     my $old_head = get_head();
 
-    breakwater_of $old_head, 'unclean-stitch';
+    keycommits $old_head, \&fproblem, \&fproblem, \&fproblem;
 
     push @deferred_updates, "delete $ffq_prev $prev";
 
@@ -1311,7 +1344,7 @@ sub cmd_convert_to_gbp () {
     badusage "no arguments allowed" if @ARGV;
     my $head = get_head();
     my (undef, undef, undef, $ffq, $drlast) = ffq_prev_branchinfo();
-    my $bw = breakwater_of $head;
+    my ($anchor, $bw) = keycommits $head, 0;
     fresh_workarea();
     my $out;
     in_workarea sub {