view release on metacpan or  search on metacpan

lib/App/karr.pm  view on Meta::CPAN

# `karr --dir PATH get-refs REF` leaves the alias at index 2, where the old
# position-0-only rewrite never saw it. Leaving argv untouched also keeps a
# payload that merely spells an alias intact -- `karr set-refs REF set-refs`
# stores "set-refs", it does not store "setrefs" -- because only the token
# MooX::Cmd itself dispatches on is ever consulted.
my %COMMAND_ALIASES = (
  'set-refs'   => 'setrefs',
  'get-refs'   => 'getrefs',
  'agent-name' => 'agentname',
);

around _build_command_commands => sub {
  my ($orig, $self, @args) = @_;
  my $commands = $orig->($self, @args);
  for my $alias (keys %COMMAND_ALIASES) {
    my $name = $COMMAND_ALIASES{$alias};
    $commands->{$alias} = $commands->{$name} if $commands->{$name};
  }
  return $commands;
};

my @COMMANDS = (
  [ init      => 'Initialize a new karr board' ],
  [ create    => 'Create a new task' ],
  [ list      => 'List and filter tasks' ],
  [ show      => 'Show full task details' ],
  [ board     => 'Show board summary' ],
  [ dashboard => 'Multi-board overview of boards under a directory' ],
  [ move      => 'Change task status' ],
  [ edit      => 'Modify task fields' ],
  [ delete    => 'Delete a task' ],
  [ pick      => 'Claim the next available task' ],
  [ unlock    => 'Show or break pick locks' ],
  [ archive   => 'Archive a task (soft-delete)' ],
  [ handoff   => 'Hand off a task for review' ],
  [ needs     => 'Report or resolve cross-board dependencies' ],
  [ destroy   => 'Delete the entire refs/karr/* board' ],
  [ config    => 'View or modify board config' ],
  [ disable   => 'Disable automated agent runs on this board' ],
  [ enable    => 'Re-enable automated agent runs on this board' ],
  [ context   => 'Generate board context summary' ],
  [ log       => 'Show activity log' ],
  [ metrics   => 'Show flow metrics' ],
  [ backup    => 'Export refs/karr/* as YAML' ],
  [ restore   => 'Replace refs/karr/* from YAML' ],
  [ materialize => 'Write refs/karr/* out as a tasks/ file view' ],
  [ import    => 'Import a tasks/ file view into refs/karr/*' ],
  [ repair    => 'Migrate a 0.402-or-earlier board off double-encoded UTF-8' ],
  [ sync      => 'Sync board with remote' ],
  [ 'agent-name' => 'Generate a random agent name' ],
  [ skill     => 'Install/update agent skills' ],
  [ 'set-refs' => 'Store helper payloads in a Git ref' ],
  [ 'get-refs' => 'Fetch and print helper payloads from a Git ref' ],
);

sub _print_help {
  my ($self_or_class, $code) = @_;
  $code //= 0;

  my $out = '';
  $out .= colored("karr", 'bold') . " - Kanban Assignment & Responsibility Registry\n\n";
  $out .= colored("USAGE:", 'bold') . " karr [--dir PATH] <command> [options]\n\n";
  $out .= colored("COMMANDS:", 'bold') . "\n";

  my $max = 0;
  for (@COMMANDS) { $max = length($_->[0]) if length($_->[0]) > $max }

  # Pad on the VISIBLE width, then colour. sprintf's %-*s counts the ANSI
  # escapes colored() wraps around the name, and those alone already exceed
  # $max, so a "%-*s" over the coloured string never pads at all and the
  # descriptions come out ragged. Padding by hand off the bare command name
  # is correct whether or not colored() actually emits escapes (it returns
  # the text untouched under NO_COLOR/ANSI_COLORS_DISABLED).
  for my $cmd (@COMMANDS) {
    $out .= sprintf "  %s%s  %s\n",
      colored($cmd->[0], 'cyan'),
      ' ' x ($max - length $cmd->[0]),
      $cmd->[1];
  }

  $out .= "\n" . colored("OPTIONS:", 'bold') . "\n";
  $out .= "  --dir PATH   Starting path for Git repository discovery\n";
  $out .= "  --json       JSON output (most commands)\n";
  # Named in full rather than "(list, board)": --compact is declared by
  # App::karr::Role::CompactOutput, which exactly these nine commands compose,
  # and anywhere else it is an unknown option that exits 2 (#254). The old
  # parenthesis named two of them and read like a shortened list.
  $out .= "  --compact    Compact output (board, config, context, dashboard,\n";
  $out .= "               list, log, metrics, pick, show)\n";
  $out .= "\n" . colored("EXAMPLES:", 'bold') . "\n";
  $out .= "  karr init --name \"My Project\"\n";
  $out .= "  karr create --title \"Fix login bug\" --priority high\n";
  $out .= "  karr list --status todo,in-progress\n";
  $out .= "  karr move 1 in-progress --claim agent-fox\n";
  $out .= "  karr pick --claim agent-fox --move in-progress\n";
  $out .= "  karr backup > karr-backup.yml\n";
  $out .= "  karr restore --yes < karr-backup.yml\n";
  $out .= "  karr set-refs superpowers/spec/1234.md draft ready\n";
  $out .= "  karr board\n";
  $out .= "\nRun " . colored("karr <command> --help", 'bold') . " for command-specific options.\n";

  # Exit-code contract (ADR 0002): a positive code here is a usage/option-parse
  # error from MooX::Options (unknown option, bad value on the root command), so
  # normalize it to 2. Help requests (-h/--help) arrive with code 0 -> exit 0.
  # A negative code means "print, do not exit" and is left untouched.
  $code = 2 if $code > 0;

  # The root reaches this instead of App::karr::Role::ExitCodes' options_usage
  # wrapper (the `around` below hands it $code and never calls $orig), so the
  # reordering of ticket k263 is asked for here by name: the diagnostic
  # MooX::Options already wrote is buffered, and this puts it back AFTER the
  # block above with the invocation that would have worked under it, then exits.
  # It returns 0 when there is nothing to move -- a help request, or a call
  # that did not come out of option parsing at all -- and has then printed
  # whatever was buffered unchanged, which is what the two lines below expect.
  $self_or_class->_usage_error_last( $out, $code );

  if ($code > 0) { warn $out } else { print $out }
  exit $code if $code >= 0;
}

around options_usage      => sub { $_[1]->_print_help($_[2]) };
around options_help       => sub { $_[1]->_print_help($_[2]) };
around options_short_usage => sub { $_[1]->_print_help($_[2]) };

sub execute {
  my ($self, $args_ref, $chain_ref) = @_;

  # A leftover positional here means MooX::Cmd could not dispatch it to any
  # App::karr::Cmd::* subcommand: it is an unknown command, not a request for
  # the default board view. MooX::Cmd echoes already-parsed option flags AND
  # the values they consumed (e.g. `--done`, or `--dir PATH` in space form)
  # back into $args_ref, so run the leftover argv through the option-aware
  # positional_args extractor rather than a raw non-dash grep -- otherwise a
  # space-form option value such as the `--dir PATH` path is misread as an
  # unknown bare command. Bare `karr` and `karr --done` legitimately fall
  # through to the board summary below.
  my ($unknown) = $self->positional_args($args_ref);
  if (defined $unknown) {
    # The way out was prose ("Run 'karr --help' ...") where it could be a line to
    # copy (ticket k264). The "Unknown command:" marker MUST stay at the start of
    # the first line -- App::karr::Error::is_usage_error and bin/karr classify the
    # exit code on it (ADR 0002, exit 2) -- so the hint goes on the line after it,
    # last, the way every k263 suggestion does. `--help` is a real token, not a
    # placeholder, so the line is printed rather than withheld.
    die "Unknown command: $unknown\n" . App::karr::Error::command_hint('--help') . "\n";
  }

  # Default action: show board summary. The default Board is constructed
  # directly (not dispatched by MooX::Cmd), so it has no command_chain to adopt
  # --dir from; forward the root's own --dir explicitly so bare
  # `karr --dir PATH` targets PATH rather than silently falling back to cwd.
  #
  # Board's own errors reach the CLI unchanged. This used to run in an eval that
  # rewrote anything matching /No karr board found/ into that same sentence --
  # a no-op while the sentence was all there was to say, and a downgrade the
  # moment it was not: bare `karr` in a fresh clone must say that refs/karr/*
  # are merely unfetched and name 'karr sync', which is precisely the wording
  # that rewrite would have thrown away (#135).
  my %board_args = (