git-batch-bisect

#!/usr/bin/perl -w

# See the associated README.md

# vim:foldmethod=marker

# Pragmas and Modules # {{{1

use strict;
use warnings FATAL => 'all';
use v5.20;
use feature qw(signatures);
no warnings qw(experimental::signatures);

use Carp qw( confess );
use Cwd qw( abs_path cwd );
use Data::Dumper;
use Fcntl;
use File::Path qw( make_path );
use File::Spec;
use File::Temp qw( tempfile );
use Getopt::Long qw( GetOptions );

# }}}1

# FIXXME: could do whatever the current magic is to discover our own name here
my $pn = 'git-batch-bisect';   # Program Name

sub system_bash ($cmd) { # {{{1 # Like system(), but use /bin/bash not /bin/sh
    my @args = ('/bin/bash', '-c', $cmd);
    return system(@args);
} #}}}1
sub sysck ($cmd) { # {{{1 # Like system_bash() but error check is integrated
    not system_bash $cmd or confess "command '$cmd' returned non-zero";
} # }}}1
sub btck ($cmd) { # {{{1 # Like backticks but error check and chomp() are integrated
    my $result = `$cmd`;
    $? == 0 or confess "backtick command '$cmd' returned non-zero";
    chomp($result);
    return $result;
} # }}}1
sub btck_bash ($cmd) { # {{{1 Like backtick but use /bin/bash not /bin/sh

    # Temp File Handle.  Not requesting name means it will get auto-unlinked
    my $tfh = tempfile();

    # Keep temp file descriptor open across exec so we can use it from shell
    my $flags = fcntl $tfh, F_GETFD, 0 or die "fcntl F_GETFD: $!";
    fcntl $tfh, F_SETFD, $flags & ~FD_CLOEXEC or die "fcntl F_SETFD: $!";

    # Execute command using bash with stdout redirected to our temp file handle
    my @args = ('/bin/bash' , '-c', "($cmd)" ." >&".fileno($tfh));
    system(@args);

    # Seek back to start of temp file and read and return its contents
    seek $tfh, 0, 0 or die;
    my @lines = <$tfh>;
    return join("\n", @lines);

} # }}}1
sub mem_total () { # Total system memory accoding to /proc/meminfo, or -1 {{{1
    # Returns the MemTotal from /proc/meminfo, or -1 on failure
    my $regexp = '^MemTotal:\s+\K\d+(?=\s+kB)';
    my $result = `grep -oP '$regexp' /proc/meminfo`;
    $? == 0 or return -1;   # In case we're on BSD or something
    chomp($result);
    return $result;
} # }}}1
sub wtd () { # {{{1   # WorkTrees Dir

    # This sets the policy by which we decide where worktrees for the
    # individual commits should go

    my $cwd = cwd();
    my $cdn = [File::Spec->splitpath($cwd)]->[2];   # Current Dir Name
    my $result = "$cwd/../$cdn.$pn";   # Current Worktree Dir Path
    # Git's worktree namespace necessarily does this anyway: symlinking to
    # a repo and batch-bisect start ends up creating the same worktrees as
    # the non-symlinked repo would get.  So for (some) clarity we go ahead
    # and do it here.
    $result = abs_path($result);

    return $result;

} # }}}1
sub cwtp ($commit) { # {{{1   Commit WorkTree Path

    return wtd()."/$commit"

} # }}}1
sub trimmed_commit_list($nbc, $obcs, $fp, $paths) { # {{{1

  # Return list of commits reachable from $nbc but not from any of @$obcs,
  # subject to --first-parent and not including $nbc or any of @$obcs
  # themselves, i.e. "between" @$obcs and $nbc subject to --first-parent.

  my $pfpo = ($fp ? '--first-parent' : '');   # Possible --first-parent Option

  # Old Behavior Commits Part
  my $obcp = join(' ', map { "^$_" } @$obcs);

  # Paths Part (as string of paths).  Note that when the [$paths] argument
  # passed to us was obtained by parsing git bisect log output these paths
  # may be quoted.  But that shouldn't matter.
  my $pp = join(' ', @$paths);

  # Commit List
  my @cl = split(/\n/, btck("git rev-list $pfpo $nbc $obcp -- $pp"));

  # At this point @cl will include $nbc which we don't want, so make sure
  # we have it's SHA1 ($nbc might be a tag or something here) and remove it
  my $lc_sha1 = btck("git rev-parse --verify $nbc^{commit}");
  @cl = map { $_ eq $lc_sha1 ? () : ($_) } @cl;   # Filter out $lc_sha1

  return @cl;

} # }}}1
my $sha1_mcc = 27;   # SHA1 Minimum Char Count.  I think they're always >=this
my $sha1_rgx = "[0-9a-f]{$sha1_mcc,}";   # SHA1 regex
sub commit_list() { # {{{1

  # Require that a bisection is in progress, and return list of *all*
  # the commits in the current bisection (not just the remaining ones)
  # by parsing git bisect log output.

  my $blo = btck("git bisect log");   # Bisect Log Output
  my @blo = split(/\n/, $blo);   # Bisect Log Output (as array of lines)

  # NOTE: The log parsing below was developed mainly using the log that results
  # from:
  #
  #     bb start master fc7a1fe274a3cd0111ccd882da8043ac39bfeeb0 18071e1457c87879f6493af39bcff46cdf5bc6fc
  #
  # in test_repos/with_merged_branch (which I'm planning to ultimately be
  # stored in tar form so the name may be different).

  # FIXXME: I'd rather use --term-old and --term-new here, and git bisect
  # terms supports them but doesn't document that support at the moment so
  # I'm staying iwth good/bad for now
  # FIXXME: would it be better to look in .git/BISECT_TERMS, where these are
  # stored?  It might be less likely to change, but then again these generate
  # just a single word of output and seem pretty --procelain-esque
  my $old_term = btck("git bisect terms --term-good");
  my $new_term = btck("git bisect terms --term-bad");

  # First line describes the bad (new) commit
  my $bl1 = shift(@blo);
  my $mcc = 27;   # I think commits as showin in log are always >this long
  $bl1 =~ m/^# \Q$new_term\E: \[($sha1_rgx)\]\s+.*$/m
      or confess "unexpected match failure";
  my $nbc = $1;

  # Next should be one or more lines describing initial good (old) commits
  # (these should be ended by the line recording the git bisect start command).
  my @obc = ();
  while ( $blo[0] =~ m/^# \Q$old_term\E: \[($sha1_rgx)\]\s+.*$/m ) {
      push(@obc, $1);
      shift @blo;
  }
  @obc >= 1
      or confess "didn't find >= 1 lines describing initial good commit(s)";

  # FIXXME: subsequent good/bad actions end up adding more lines like
  # the above to the log, below the line containing the copy of the git
  # bisect start command.  So it would probably be pretty easy to make a
  # 'runinremaining' command that would happen in all as-yet-unbisected
  # commits.  But I don't know if there's any point.

  $blo =~ m/^git bisect start (.*)$/m or confess "unexpected match failure";
  my $bsoaa = $1;   # Bisect Start Opts And Args

  my $fp = ($bsoaa =~ m/'(--first-parent)'/);   # --first-parent?

  # Paths arguments (if any) as an array
  my @paths = split(' ', ($bsoaa =~ m/'--'\s+([^\s].*)$/ ? $1 : ''));

  my @cl = trimmed_commit_list($nbc, \@obc, $fp, \@paths);

  return @cl;

} # }}}1
sub worktree_list ($abs_wtd) { # {{{1

    # Return list of all worktree names of the form ${abs_wtd}<sha1>

    # git worktree list Output Lines
    # FIXXME: the git-worktree docs suggest using -z with --porcelain so the
    # output can be parsed when a worktree path contains a newline, but we
    # haven't considered making that work anywhere else anyway.
    my @gwlol = split("\n", btck("git worktree list --porcelain"));

    # FIXXME: at this point @gwlol contains lines describing the HEAD
    # position of each work tree, in theory we could be using this to check
    # if the has made commits in there to support refusal to operate (in our
    # worktree-removing caller) if they have.  But in theory such commits
    # should show up elsewhere, and if we do that we should be checking for
    # cleanliness of those working trees as well.

    my @result
        = map { m/^worktree (\Q$abs_wtd\E\/$sha1_rgx)$/ ? ($1) : () } @gwlol;

    return @result;
} # }}}1
sub opt_descriptions ($opts) { # {{{1

    # Return a more man-esque array of option descrtiptions from the kind
    # normally given to GetOptions

    return [ sort map {  m/^([-\w|?]+)$/ ?
                         "--$1" :
                         ( m/^([-\w|]+)=i/ ?
                           "--$1=INT" :
                           ( m/^([-\w|]+)=f/ ?
                             "--$1=FLOAT" :
                             ( m/^([-\w|]+)=s/ ?
                               "--$1=STRING" :
                               () ) ) ) }
                      %$opts ];
} # }}}1
sub usage ($action, $opts, $args) # {{{1
{
    # Command Part of Program Name
    my $cppn = ($pn =~ s/^git-//r);

    return(
        "usage: git $cppn $action $args\n\n    ".
        join("\n    ", @{opt_descriptions($opts)})."\n\n" );
} # }}}1
sub cnoa ($avr, $relation, $count, $action) { # Check Number Of Arguments {{{1

    my $ac = scalar(@$avr);   # Arg Count (from @ARGV ref)

    my $is_correct = 1;
    if    ( $relation eq '==' ) {
        ($ac == $count) or ($is_correct = 0);
    }
    elsif ( $relation eq '>=' ) {
        ($ac >= $count) or ($is_correct = 0);
    }
    else {
        confess "shouldn't be here";
    }

    my $staon = ($action ? " $action" : '');   # Space Then Action Or Nothing

    $is_correct
        or die "wrong number of arguments for $pn$staon, try `$pn$staon ".
               "--help'\n";

} # }}}1
sub is_valid_term_action ($action) { # {{{1

    # Return true iff $action is one of the normal term actions
    # (new|bad|old|good) or a bisection is in progress and $action is a
    # custom term action previously specified with --term-(new|bad|old|good).
    # Note that true is always returned for literal (new|bad|old|good)
    # even if the other pair of terms or a custom term action is in use
    # (git bisect always recognizes these words even if they're wrong for
    # the current case, so we end up wanting to let them through at this
    # point and let git bisect show the error later).

    if ( $action =~ m/^(?:new|bad|old|good)$/ ) {
        return 1;
    }
    elsif ( not system("git bisect log 1>/dev/null 2>/dev/null") ) {
        return (
            $action eq btck("git bisect terms --term-bad")
                or
            $action eq btck("git bisect terms --term-good") );
    }
    else {
        return 0;
    }

} # }}}1
sub is_ancestor ($ra, $rb) { # {{{1

    # Return true iff $ra is an ancestor of $rb, or false iff it isn't,
    # or confess on other error.


    my $cmd = "git merge-base --is-ancestor $ra $rb";
    my $es = system($cmd);

    system($cmd);
    if ( $? != 0 ) {
        # Voodoo to get actual Exit Status, see perl -f system
        my $es = ($? >> 8);
        # git merge-base returns > 1 on error (and 1 on "not ancestor")
        $es == 1 or confess "exit status of `$cmd' was > 1";
    }

    return not $?;

} # }}}1

# FIXME: try running with < parallel --number-of-threads and see if system
# stays a bit more responsive with a thread or two to spare

cnoa(\@ARGV, ">=", 1, "");

my $action = shift @ARGV;

# Per-repository lock {{{1

my $ld = "/tmp/$pn-locks".cwd();   # Lock Dir
make_path($ld);
my $lf = "$ld/lock";   # Lock File
my $drlf = 0;   # Don't Remove Lock File

# This will clean up the lock unless user kills us with an unhandleable signal
END {
    $drlf or (unlink($lf) == 1) or die "failed to unlink $lf: $!";
}

# The user is likely to want to keep the view around while doing
# good/bad/etc. and it's read-only so that should be fine.
#
# FIXXME: there are other operations that could be considered read-only,
# and visualize probably won't do anything useful while a start action is
# in progress, but we're going to ignore those issues for the moment.
#
unless ( $action eq 'visualize' or $action eq 'view' ) {
    if ( not -e $lf ) {
        sysck("touch $lf");
    } else {
        $drlf = 1;   # Because we're goind to die *becase* of an existing lock
        die "lock file $lf already exists, and only one copy of $pn per ".
            "repository can run at a time.  If you know the lock is stale ".
            "simply remove it";
    }
}
else {
    $drlf = 1;   # Because we don't ever create it in this case
}


# }}}1

if    ( $action eq 'start' ) { # {{{1

    # Option and argument parsing {{{2

    my $fp = 0;   # --first-parent (flag)
    my $hf = 0;   # Help Flag
    my $nc = 0;   # --no-checkout (flag)
    my ($tn, $tb, $to, $tg) = (0, 0, 0, 0);   # --term-{new,bad,old,good}
    my %opts = (
        "first-parent"       => \$fp,
        "help|?"             => \$hf,
        "no-checkout"        => \$nc,
        "term-new=s"         => \$tn,
        "term-bad=s"         => \$tb,
        "term-old=s"         => \$to,
        "term-good=s"        => \$tg );

    # git bisect interprets '--' differently than GetOptions() of
    # Getopt::Long: the former requires it to separate [<bad> [<good>]]
    # rev arguments from <path> arguments, while GetOptions() considers it
    # to indicate that all the following arguments are not to be considered
    # options (regardless of any leading '-' or '--') and filters it out
    # when it runs.  So we have to check for it here and pop off any <path>
    # arguments before calling GetOptions().
    my @paths = ();
    for ( my $ii = 0 ; $ii < @ARGV ; $ii++ ) {
        if ( $ARGV[$ii] eq '--' ) {
            if ( @ARGV > $ii + 1 ) {
                push(@paths, splice(@ARGV, $ii + 1));
            }
        }
    }

    GetOptions(%opts)
        or die "\nError parsing options.  Try `$pn $action --help'.\n";

    if ( $hf ) {
        print
            usage(
                $action,
                \%opts,
                '[<options>] <bad> <good>... [--] [<path>...]' );
        exit(0)
    }

    # Re-expanding these like this so we can pass them to the git commands is
    # sort of dumb but keeps argument counting simple.  Users who are using
    # quotes in their terms are boned though :)
    my $pfpo = $fp ? '--first-parent' : '';   # Possible --first-parent Option
    my $pnco = $nc ? '--no-checkout' : '';    # Possible --no-checkout Option
    my $pto = (                               # Possible --term-* Options
        ($tn ? "--term-new='$tn' "  : '') .
        ($tb ? "--term-bad='$tb' "  : '') .
        ($to ? "--term-old='$to' "  : '') .
        ($tg ? "--term-good='$tg' " : '') );

    if ( @ARGV < 2 ) {
        # We require this because it avoids the wierd state of
        # "started-but-not-bounded-yet and lets us set up the commit worktrees
        # up front.
        die "\n".
            "too few non-<path> arguments to $pn start subcommand.  Unlike ".
            "`git bisect start', `git batch-bisect start' requires that a ".
            "bad commit and at least one good commit be provided to the ".
            "start command.\n".
            usage(
                $action,
                \%opts,
                '[<options>] <bad> <good>... [--] [<path>...]' );
    }

    # Note that we already remove any <path>s arguments above (and GetOptions()
    # remove any '--' arguments)
    my ($nbc, @obc) = @ARGV;   # New Behavior Commit/Old Behavior Commit(s)

    not system("git rev-parse --quiet --verify $nbc^{commit} >/dev/null")
        or die "`$nbc' doesn't look like a commit";
    foreach ( @obc ) {
        not system("git rev-parse --quiet --verify $_^{commit} >/dev/null")
            or die "`$_' doesn't look like a commit";
    }

    # }}}2

    # Check that @obc-$nbc relationship is sane {{{2

    # As of this writing (2023-12-17) git gives this crap message when $nbc is
    # an ancestor of an @obc:
    #
    #    $ git bisect start oldest_commit newest_commit
    #    Some good revs are not ancestors of the bad rev.
    #    git bisect cannot work properly in this case.
    #    Maybe you mistook good and bad revs?
    #
    # This is bad because it's wrong in general: if <good> is not an ancestor
    # of <bad> because <good> is on an unmerged branch git will automatically
    # find the common ancestor and use that as the starting <good> point for
    # the bisection (and it then correctly notices if the <good> behavior is
    # in fact introduced on the branch with it's subsequent messaging).  So
    # here we give a message describing the actual problem.
    #
    foreach my $obc ( @obc ) {

        not is_ancestor($nbc, $obc)
            or die "bad (new behavior) commit `$nbc' is an ancestor of good ".
                   "(old behavior) commit `$obc'.  Maybe you got the ".
                   "good/bad (old/new) commits swapped?";

        if ( not is_ancestor($obc, $nbc) ) {

            # Common Ancestor-Finding Command
            my $cafc = "git merge-base $obc $nbc";

            # I'm not sure when this would happen but for caution let's trap it
            not system("$cafc 1>/dev/null 2>/dev/null")
                or confess "commit `$obc' is not an ancestor of `$nbc' or ".
                           "vice versa and `git merge-base $obc $nbc' failed ".
                           "to find a common ancestor";

            # Regarding automagical selection of common ancestor commits as
            # a starting point, in particular in combination with multiple
            # <good> commits, in with_unmerged branch test repo I currently
            # see this behavior:
            #
            #     $ git bisect start master unmerged_test_branch 32d0cd24973d35ad97bdc747ac29f21b06f18bce
            #     Bisecting: a merge base must be tested
            #     [b93212577c2e8603ed7285b55a0931dcf552c628] I'm yet another test commit
            #     $ git bisect bad
            #     The merge base b93212577c2e8603ed7285b55a0931dcf552c628 is bad.
            #     This means the bug has been fixed between b93212577c2e8603ed7285b55a0931dcf552c628 and [1b4470e66cb26244be9aa5f68cca042a0ef4270e 32d0cd24973d35ad97bdc747ac29f21b06f18bce].
            #
            # See the gitk also, that report seems to be saying the bug is
            # fixed by going back in time from the merge point, or forward
            # in time on the branch.  Yikes.  Multiple <good> marks with
            # merge base testing is implemented so I guess probably somebody is
            # using it in some non-redundant way but I think I'm not interested
            # and will just keep on having batch-bisect advise the user to use
            # merge-base manually when it runs into this stuff.

            die "$obc isn't an ancestor of $nbc.  In this situation git ".
                "bisect normally automagically selects a common ancestor for ".
                "the starting point.  Partly for implementation reasons and ".
                "partly because it's potentially confuing to do that (the ".
                "\"old\" behavior might after all have been introduced in ".
                "one of the non-common commits as discussed here: ".
                "https://mirrors.edge.kernel.org/pub/software/scm/git/docs/git-bisect-lk2009.html".
                ") $pn doesn't do it, but you can use `$cafc' to find a ".
                "common ancestor to use instead of $obc (i.e. manually do ".
                "what regular `git bisect start' does in this situation)";

        }
    }

    # }}}2

    # Ensure dir where we will keep worktrees exists # {{{2

    my $wtd = wtd();

    if ( -e $wtd ) {
        -d $wtd or confess "'$wtd' exists but is not a directory";
    }
    else {
        -e $wtd or mkdir $wtd
            or confess "failed to create directory '$wtd': $!";
    } # }}}2

    # The underlying git bisect start command tolerates invocation when
    # bisection is already in progress but FIXXME: I don't know why and
    # don't feel like figuring it out and deciding what batch-bisect should do
    system_bash("git bisect log &>/dev/null")
        or die "bisection (possibly batch-bisection) already in progress\n";

    # FIXXME: currently we make no attempt to unwind this on err creating
    # working trees below.  But I think all those fails are pretty much bugs
    # (or maybe out of disk space :)
    sysck("git bisect start ".
          "$pto $pnco $pfpo $nbc ".
          join(' ', @obc).
          " -- ".
          join(' ', @paths));

    my @cl = trimmed_commit_list($nbc, \@obc, $fp, \@paths);

    # Ensure worktrees exist # {{{2
    my $use_worktrees = 1;
    foreach ( @cl ) {
        my $cp = cwtp($_);   # Commit Path
        unless ( $use_worktrees ) {
            die "this code path worked to create the dir at least but hasn't ".
                "been used for other actions (e.g. cleanupall)";
            # FIXXME: well pcb doesn't ./autogen.sh correctly from a dir
            # created this way (though the source reads like it intends to),
            # and I bet this is pretty common these days, so probably the
            # worktree way should be the default, and idk if we even want
            # to suppport this
            (-d $cp and next)
                or mkdir $cp or confess "failed to create directory '$cp': $!";
            # Well this is stupid but I didn't find a better and easy way
            # to do it.  We could probably safely parallel this but I'm sure
            # that's not in spec.
            sysck("(git archive $_ -o $cp/tmp.tar && cd $cp && tar xf tmp.tar)");
        }
        else {
            # NOTE: As of this writing the worktree gets a checkout in
            # detached HEAD state due to being checked out by SHA1 rather
            # than by branch name, but we use --detach to be sure because git
            # worktree won't allow multiple worktrees to point to the same
            # 'ref' (per documentation for --ignore-other-worktrees in the
            # git-checkout and git-switch man pages).  It would be pretty
            # confusing if the user couldn't check out random commits due
            # to batch-bisect being in progress.
            (-d $cp and next) or sysck("git worktree add --detach $cp $_");
        }
    } # }}}2

} # }}}1
elsif ( $action eq 'runinall' ) { # {{{1

    # Run an instance of a command in each of the commit trees.  The stdout
    # and stderr of the commands is redirected to log files (unless the user
    # redirects it somewhere else in their provided command).

    my $cmd = join(' ', @ARGV);

    # Require an ongoing bisection (which we assume is a $pn :)
    not system("git bisect log >/dev/null")
        or die "no bisection in progress\n";

    my $wtd = wtd();   # WorkTree Dir

    my @cl = commit_list();   # Commit List

    my @cdp = map { cwtp($_) } @cl;   # Commit Dir Paths

    print 'About to run command `'.$cmd."' in all ".scalar(@cdp)." commit ".
          "worktree dirs (logging stdout and stderr in files in $wtd)\n";

    my $qec = ($cmd =~ s/'/'"'"'/gr);   # Quote-Escaped Command

    # Wrapped Quote-Escaped Command (to be invoked by GNU Parallel).
    # This puts us in the right dir and does logging
    my $wqec = "(cd {} && (((($qec) 1>{}.stdout_log 2>{}.stderr_log) && echo command succeeded in {}) || ((echo command failed in {} 1>&2) && false)))";

    # Cobble together a decent --memsuspend option to try, iff /proc/meminfo is
    # available
    my $mt_kb = mem_total();   # Mem Total in kB
    my $mvpt = 0.10;   # --memsuspend value percent total
    my $mv_kb = sprintf "%.0f", $mt_kb * $mvpt;   # --memsuspend value in kB
    my $mso = ( $mt_kb != -1 ? "--memsuspend=${mv_kb}k": '');

    # Use a temp file and :::: rather than ::: to avoid too long command line:
    my ($tfh, $tfn) = tempfile();   # Temp File Handle/Name
    print $tfh join("\n", @cdp) or confess;
    close $tfh or confess;
    # Parallel Command
    my $pc = "parallel --plain --nice=17 --load=80% $mso '$wqec' :::: $tfn";
    my $cf = 0;   # Command Failed
    not system_bash $pc or ($cf = 1);
    unlink $tfn or confess;
    not $cf or die "command failed in at least one commit tree";

} # }}}1
elsif ( $action eq 'runinrange' ) { # {{{1

    die "FIXXME: could implement this to run build commands for just a range ".
        "of commits (so we could bisect across a change in build procedure)";

} # }}}1
elsif ( $action eq 'runincurrent' ) { # {{{1

    # Run a command in the worktree associated with the commit currently
    # being tested.  This is presumably a test command of some sort, so
    # stdout and stderr are not redirected anywhere (and no logging is done).

    # Require an ongoing bisection (which we assume is a $pn :)
    not system("git bisect log >/dev/null")
        or die "no bisection in progress\n";

    my $cmd = join(' ', @ARGV);

    my $od = cwd();   # Old Dir

    # Current Commit SHA1.  First look for BISECT_HEAD which will be present
    # if we're in a --no-checkout bisection, and if that isn't there assume
    # we're not in a --no-checkout bisection and look for HEAD.
    my $ccs = `git rev-parse --verify BISECT_HEAD^{commit} 2>/dev/null`;
    if ( $? != 0 ) {
        $ccs = btck('git rev-parse --verify HEAD^{commit}');
    }
    else {
        chomp($ccs);
    }

    my $wtp = cwtp($ccs);
    chdir($wtp) or confess("chdir(\"$wtp\") failed: $!");

    not system_bash $cmd or die "command failed in current commit tree";

    chdir($od) or confess("chdir(\"$od\") failed: $!");

} # }}}1
elsif ( is_valid_term_action($action) ) { # {{{1

    sysck("git bisect $action ".join(' ', @ARGV));

} # }}}1
elsif ( $action eq 'terms' ) { # {{{1

    sysck("git bisect terms ".join(' ', @ARGV));

} # }}}
elsif ( $action eq 'skip' ) { # {{{1

    sysck("git bisect skip ".join(' ', @ARGV));

} # }}}1
elsif ( $action eq 'reset' ) { # {{{1

    sysck("git bisect reset ".join(' ', @ARGV));

} # }}}1
elsif ( $action eq 'visualize' or $action eq 'view' ) { # {{{1

    sysck("git bisect visualize ".join(' ', @ARGV));

} # }}}1
elsif ( $action eq 'replay' ) { # {{{1

    @ARGV == 1 or die "wrong number of arguments for $action";

    my $logfile = $ARGV[0];

    sysck("git bisect replay $logfile");

} # }}}1
elsif ( $action eq 'log' ) { # {{{1

    @ARGV == 0 or die "wrong number of arguments for $action";

    sysck("git bisect log");

} # }}}1
elsif ( $action eq 'run' ) { # {{{1

    sysck("git bisect run ".join(' ', @ARGV));

} # }}}1
# FIXXME: We have --help here but unfortunately it looks like
# `git batch-bisect --help get intercepted by git itself and tries to open the
# man page for git-batch-bisect, which at the moment we don't create.  I don't
# think it's worth making a man page and full installer over this issue.
elsif ( $action =~ m/^(?:help|--help|-\?|-h)$/ ) { # {{{1

    # FIXXME: add runinrange in here if it gets implemented:
    print <<"END_TOP_LEVEL_HELP";

    $pn COMMAND [OPTION]...

    COMMAND is one of:

      start
      runinall
      runincurrent
      new
      old
      terms
      skip
      reset
      visualize
      replay
      log
      run
      cleanupall
      help

    Please see also the markdown for $pn-specific help.  For help with git
    bisect try `git bisect help' or `man git-bisect'.

END_TOP_LEVEL_HELP

} # }}}1
elsif ( $action eq 'cleanupall' ) { # {{{1

    # Remove *all* batch-bisect-related worktrees and the worktree directory
    # and end any current bisection (with git bisect reset).  This should
    # remove everything even if some other operation failed in the middle.
    #
    # FIXXME: There is currently no automatic way to do partial cleanup:
    # either all the commits and worktrees stay around, or they are nuked en
    # masse with this action.  Middle policies would of course be possible
    # but are painful to specify and implement (probably the most useful
    # fix would be to implement a -d option to specify worktree to use other
    # than the default).

    # Option and argument parsing {{{2

    my $force = 0;
    my $hf    = 0;
    my %opts = (
        "force"  => \$force,
        "help|?" => \$hf );

    GetOptions(%opts)
        or die "\nError parsing options.  Try `$pn $action --help'.\n";

    if ( $hf ) {
        print usage($action, \%opts, '[<options>] [<commit>]');
        exit(0)
    }

    @ARGV == 0 or @ARGV == 1 or die "wrong number of arguments for $action";

    # }}}2

    my $wtd = wtd();

    # NOTE --force is an undocumenbted option at this point, since all it's
    # really good for cleaning up both regular git bisections (started with
    # `git bisect start') and batch-bisects.  But if something goes haywire
    # it could be useful for cleaning up worktree fallout, so maybe it should
    # get documented (though I hate the clutter).

    unless ( $force ) {
        -d $wtd
            or die "`$wtd' doesn't exist or isn't a directory, probably no ".
                   "$pn is in progress.  Use `$pn cleanupall --force' to try ".
                   "to clean up worktrees and reset bisection anyway.\n";
    }

    # git worktree list records the names as absolute paths so get those
    my $abs_wtd = abs_path($wtd);

    foreach ( worktree_list($abs_wtd) ) {
        sysck("git worktree remove --force $_");
    }

    sysck("rm -rf $wtd");

    sysck("git bisect reset ".join(' ', @ARGV));

} # }}}1
else { # {{{1

        die "invalid action '$action'";

} # }}}1