return $snags_forced || $snags_tripped;
}
+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.
+ runcmd @git, qw(checkout -q -b), $bname, $base;
+ runcmd @git, qw(checkout -q -b), "patch-queue/$bname", $tip;
+ my @gbp_cmd = (qw(gbp pq export));
+ my $r = system shell_cmd 'exec >../gbp-pq-err 2>&1', @gbp_cmd;
+ if ($r) {
+ { local ($!,$?); copy('../gbp-pq-err', \*STDERR); }
+ failedcmd @gbp_cmd;
+ }
+ runcmd @git, qw(add -f debian/patches);
+}
+
# classify returns an info hash like this
# CommitId => $objid
# Hdr => # commit headers, including 1 final newline
return ($anchor, $breakwater);
}
-sub walk ($;$$);
-sub walk ($;$$) {
+sub walk ($;$$$);
+sub walk ($;$$$) {
my ($input,
- $nogenerate,$report) = @_;
+ $nogenerate,$report, $report_lprefix) = @_;
# => ($tip, $breakwater_tip, $last_anchor)
# (or nothing, if $nogenerate)
printdebug "*** WALK $input ".($nogenerate//0)." ".($report//'-')."\n";
+ $report_lprefix //= '';
# go through commits backwards
# we generate two lists of commits to apply:
my $prline = sub {
return unless $report;
- print $report $prdelim, @_;
+ print $report $prdelim, $report_lprefix, @_;
$prdelim = "\n";
};
runcmd @git, qw(rm --quiet --ignore-unmatch -rf debian/patches);
}
+sub currently_rebasing() {
+ foreach (qw(rebase-merge rebase-apply)) {
+ return 1 if stat_exists "$maindir_gitdir/$_";
+ }
+ return 0;
+}
+
+sub bail_if_rebasing() {
+ fail "you are in the middle of a git-rebase already"
+ if currently_rebasing();
+}
+
sub do_launder_head ($) {
my ($reflogmsg) = @_;
my $old = get_head();
# if "deferred", will have added something about that to
# @deferred_update_messages, and also maybe printed (already)
# some messages about ff checks
+ bail_if_rebasing();
my $currentval = get_head();
my ($status,$message, $ffq_prev,$gdrlast) = ffq_check $currentval;
}
sub ffq_prev_info () {
+ bail_if_rebasing();
# => ($ffq_prev, $gdrlast, $ffq_prev_commitish)
my ($status, $message, $current, $ffq_prev, $gdrlast)
= ffq_prev_branchinfo();
print " not git-debrebase (diverged since last stitch)\n"
}
}
+ print "you are currently rebasing\n" if currently_rebasing();
}
sub cmd_stitch () {
do_stitch 'quick';
}
+sub cmd_scrap () {
+ if (currently_rebasing()) {
+ runcmd @git, qw(rebase --abort);
+ }
+ my ($ffq_prev, $gdrlast, $ffq_prev_commitish) = ffq_prev_info();
+ if (!$ffq_prev_commitish) {
+ 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";
+}
+
sub make_patches_staged ($) {
my ($head) = @_;
# Produces the patches that would result from $head if it were
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;
- my @gbp_cmd = (qw(gbp pq export));
- my $r = system shell_cmd 'exec >../gbp-pq-err 2>&1', @gbp_cmd;
- if ($r) {
- { local ($!,$?); copy('../gbp-pq-err', \*STDERR); }
- failedcmd @gbp_cmd;
- }
- runcmd @git, qw(add -f debian/patches);
+ gbp_pq_export 'bw', $secret_bw, $secret_head;
};
}
getoptions("make-patches",
'quiet-would-amend!', \$opt_quiet_would_amend);
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;