serial-merge-prs

#!/usr/bin/env perl
use v5.36;
use JSON::PP ();

# serial-merge-prs: rebase a list of PRs onto master one at a time, force-push
# each rebased branch back to its fork, then merge it into master with a
# semilinear (--no-ff) merge and push master upstream.  Confirm everything up
# front, confirm again before each push to master, and abort on any error.

my @prs = @ARGV;
@prs or die "usage: serial-merge-prs PR_NUMBER [PR_NUMBER ...]\n";

# We rebase onto, merge into, and push the branch that master's upstream points
# at.  In this checkout that is github/master (cyrusimap/cyrus-imapd).
my $BASE = $ENV{BASE_BRANCH} // 'master';

my $upstream = capture(qw(git rev-parse --abbrev-ref), "$BASE\@{upstream}");
chomp $upstream;
$upstream =~ m{\A([^/]+)/(.+)\z}
  or die "can't parse upstream of $BASE (got '$upstream')\n";
my ($UPSTREAM_REMOTE, $UPSTREAM_BRANCH) = ($1, $2);

my $json = JSON::PP->new;

# --- preflight ------------------------------------------------------------

{
    my $dirty = capture(qw(git status --porcelain));
    die "working tree is not clean; commit or stash first:\n$dirty" if length $dirty;
}

say "Fetching $UPSTREAM_REMOTE ...";
run(qw(git fetch), $UPSTREAM_REMOTE);

{
    my $behind = capture(qw(git rev-list --count),
        "$BASE..$UPSTREAM_REMOTE/$UPSTREAM_BRANCH");
    chomp $behind;
    die "$BASE is $behind commit(s) behind $upstream; update it first\n"
      if $behind != 0;
}

# --- gather PR metadata and confirm en masse ------------------------------

my @info;
for my $num (@prs) {
    my $raw = capture('gh', 'pr', 'view', $num, '--json',
        'number,title,author,headRefName,headRepositoryOwner,headRepository,baseRefName,state');
    my $d = $json->decode($raw);
    push @info, {
        num    => $d->{number},
        title  => $d->{title},
        author => $d->{author}{login},
        branch => $d->{headRefName},
        owner  => $d->{headRepositoryOwner}{login},
        repo   => $d->{headRepository}{name},
        base   => $d->{baseRefName},
        state  => $d->{state},
    };
}

say '';
say "About to rebase + semilinearly merge the following PRs into "
  . "$UPSTREAM_REMOTE/$UPSTREAM_BRANCH:";
say '';
for my $p (@info) {
    printf "  #%-6s %s\n", $p->{num}, $p->{title};
    printf "          by \@%s  (head %s/%s:%s -> base %s, %s)\n",
        $p->{author}, $p->{owner}, $p->{repo}, $p->{branch}, $p->{base}, $p->{state};

    if ($p->{state} ne 'OPEN') {
        say "          WARNING: PR is not OPEN.";
    }
    if ($p->{base} ne $BASE) {
        say "          WARNING: PR base ($p->{base}) is not $BASE.";
    }
}
say '';

confirm("Proceed with all " . scalar(@info) . " PR(s)?")
  or die "aborted by user\n";

# --- process one PR at a time ---------------------------------------------

for my $p (@info) {
    my $num    = $p->{num};
    my $branch = $p->{branch};
    my $fork   = "git\@github.com:$p->{owner}/$p->{repo}.git";
    my $local  = "pr/$num";

    say '';
    say "==== PR #$num: $p->{title} ====";

    say "-- fetching $p->{owner}/$p->{repo}:$branch";
    run('git', 'fetch', $fork, $branch);

    my $head_oid = capture(qw(git rev-parse FETCH_HEAD));
    chomp $head_oid;

    run('git', 'checkout', '-B', $local, 'FETCH_HEAD');

    say "-- rebasing $local onto $BASE";
    run('git', 'rebase', $BASE);

    say "-- force-pushing rebased branch to $p->{owner}/$p->{repo}:$branch";
    run('git', 'push', "--force-with-lease=$branch:$head_oid",
        $fork, "$local:refs/heads/$branch");

    run('git', 'checkout', $BASE);

    say "-- merging $local into $BASE (--no-ff)";
    run('git', 'merge', '--no-ff',
        '-m', "Merge pull request #$num from $p->{owner}/$branch",
        '-m', $p->{title},
        $local);

    confirm("Push $BASE to $UPSTREAM_REMOTE/$UPSTREAM_BRANCH now (includes PR #$num)?")
      or die "aborted by user before pushing $BASE\n";

    say "-- pushing $BASE to $UPSTREAM_REMOTE/$UPSTREAM_BRANCH";
    run('git', 'push', $UPSTREAM_REMOTE, "$BASE:$UPSTREAM_BRANCH");

    run('git', 'branch', '-D', $local);

    say "** PR #$num merged.";
}

say '';
say "All done. Merged " . scalar(@info) . " PR(s) into $UPSTREAM_REMOTE/$UPSTREAM_BRANCH.";

# --- helpers --------------------------------------------------------------

sub run (@cmd) {
    say "   \$ @cmd";
    my $rc = system @cmd;
    die "command failed (exit @{[ $rc >> 8 ]}): @cmd\n" if $rc != 0;
    return;
}

sub capture (@cmd) {
    open my $fh, '-|', @cmd or die "can't run @cmd: $!\n";
    local $/;
    my $out = <$fh>;
    close $fh;
    die "command failed (exit @{[ $? >> 8 ]}): @cmd\n" if $? != 0;
    return $out // '';
}

sub confirm ($prompt) {
    print "$prompt [y/N] ";
    my $answer = <STDIN>;
    defined $answer or return 0;
    return $answer =~ /\A\s*y(es)?\s*\z/i;
}