App-karr

 view release on metacpan or  search on metacpan

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

  [ 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

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

my %STATUS_COLOR = (
  backlog       => 'bright_black',
  todo          => 'cyan',
  'in-progress' => 'yellow',
  review        => 'magenta',
  done          => 'green',
);

my %PRIORITY_COLOR = (
  critical => 'bold red',
  high     => 'red',
  medium   => 'yellow',
  low      => 'bright_black',
);

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

  # Before anything is rendered: a repository with no board here would
  # otherwise print the default config over an empty task list, which is

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

  # Colour only when writing to a real terminal — piped or redirected output
  # stays clean plaintext so the board diffs, greps, and pastes cleanly.
  my $color = -t STDOUT && !$ENV{NO_COLOR};
  my $c = sub {
    my ($text, $spec) = @_;
    return $color ? colored($text, $spec) : $text;
  };
  my $sep = $c->('|', 'bright_black');

  print $c->("# $board_name", 'bold cyan'), "\n";

  # Hide the board's finished column unless --done was given (the footer still
  # says how many cards it withheld). Asked of the store, so a board whose
  # last column is `shipped` hides shipped work instead of a `done` it does not
  # have (#67, #234). `archived` is not in @statuses at all -- see the top.
  my @display_statuses = grep {
    $self->done || !$self->store->is_terminal_status($_)
  } @statuses;

  for my $status (@display_statuses) {
    my $tasks  = $by_status{$status} // [];
    my $label  = join ' ', map { ucfirst } split /-/, $status;
    my $accent = $STATUS_COLOR{$status} // 'white';
    print "\n", $c->("## $label", "bold $accent"), "\n";

    for my $t (@$tasks) {
      my @meta;
      if ($t->priority && $t->priority ne 'medium') {
        push @meta, $c->('priority:' . $t->priority, $PRIORITY_COLOR{$t->priority} // 'white');
      }
      # A claim is only worth showing while the work is still live, and which
      # columns count as finished is the board's decision -- a board imported
      # from kanban-md can end in `shipped`, and every finished card there
      # still carried its claimant into the board (ticket #98, following #67).
      if ($t->has_claimed_by && !$self->store->is_terminal_status($t->status)) {
        push @meta, $c->('@' . $t->claimed_by, 'cyan');
      }
      if ($t->has_blocked) {
        my $reason = $t->has_block_reason ? $t->block_reason : undef;
        $reason = substr($reason, 0, 40) . '...' if defined $reason && length $reason > 43;
        push @meta, $c->(
          defined $reason && length $reason ? "blocked:$reason" : 'blocked', 'bold red');
      }
      if ($t->has_due) {
        push @meta, $c->('due:' . $t->due, 'yellow');
      }

      my $line = join ' ', $c->('-', 'bright_black'), $t->id, $sep, $t->title;
      $line .= " $sep " . join(" $sep ", @meta) if @meta;
      print $line, "\n";

      if ($self->tags && @{$t->tags}) {

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

  # and it is the column @display_statuses withheld. The hint names it, so it
  # reads "(3 shipped hidden)" on a board that calls it that.
  my ($final_status) = grep { $self->store->is_terminal_status($_) } @statuses;
  my $hidden = ( defined $final_status && !$self->done )
    ? scalar @{ $by_status{$final_status} // [] } : 0;
  my $total_label = scalar(@tasks) . ' tasks';
  $total_label .= " ($hidden $final_status hidden)" if $hidden;
  my @summary = ( $total_label );
  push @summary, "$claimed claimed" if $claimed;
  push @summary, "$blocked blocked" if $blocked;
  print "\n", $c->(join('  ', @summary), 'bold'), "\n";
}

1;

__END__

=pod

=encoding UTF-8

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

  backlog       => 'bright_black',
  todo          => 'cyan',
  'in-progress' => 'yellow',
  review        => 'magenta',
  done          => 'green',
  archived      => 'bright_black',
);

# Decision (documented on ticket #220, karr edit 220 -a "..."): blocked cards
# are pulled out of their status colour into their own trailing bar segment,
# always bold red -- the same colour App::karr::Cmd::Board uses for
# `blocked:reason` -- so a blocked card reads as blocked at a glance instead
# of disappearing into whichever status colour it happened to be sitting in.
use constant BLOCKED_COLOR => 'bold red';

# One block character per (unscaled) open task. Decision: capped at 10 blocks
# per bar (see _scale_segments) so a busy board's entry stays short enough for
# several columns to fit side by side at an ordinary 80-column terminal --
# the whole point of "mehrspaltig" being multiple repos per screen row, not
# one very wide repo taking the row on its own.
use constant BLOCK_CHAR      => "\x{2588}";
use constant MAX_BAR_BLOCKS  => 10;
use constant COLUMN_GAP      => 2;

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

    my ( $text, $spec ) = @_;
    return $color ? colored( $text, $spec ) : $text;
  };

  # Every line printed below is fitted to this one width. Nothing may exceed
  # it: a line that is one character too long soft-wraps in the terminal, and
  # a soft-wrapped grid row destroys the column alignment this command exists
  # for -- worse than a plain one-column list would have been.
  my $width = $self->_term_width;

  print $c->( $self->_truncate( "Dashboard: $start", $width ), 'bold cyan' ), "\n\n";

  if (@boards) {
    my $name_width = 0;
    $name_width = length( $_->{name} ) > $name_width ? length( $_->{name} ) : $name_width
      for @boards;

    # The count column is the only other variable-width part; measure it so
    # the name cap below is exact rather than guessed.
    my $count_w = 0;
    for my $b (@boards) {

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

      my $short = sprintf( 'No board: %d repos',                                scalar @names );
      $hint = $short if length($hint) > $width;
      print $c->( $self->_truncate( $hint, $width ), 'bright_black' ), "\n";
    }
  }

  print "\n", $c->(
    $self->_truncate(
      sprintf( '%d repos  %d boards  %d open', scalar(@repo_dirs), scalar(@boards), $total_open ),
      $width ),
    'bold'
  ), "\n";
}

# `karr dashboard --dir PATH` was always rejected by MooX::Options (this
# command declares no such option) -- but `karr --dir PATH dashboard` was not:
# --dir is declared on App::karr::Role::BoardDiscovery, the root command
# composes it via BoardAccess, and MooX::Cmd leaves the parsed value on the
# root instance in the command chain, where nothing here ever looked. So the
# option was swallowed without a word and the scan ran on the current
# directory instead -- and a list of repositories with counts behind them