view release on metacpan or  search on metacpan

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

  doc => 'Filter by claim owner',
);

# The complete set of --sort keys, in the order the usage message lists them.
# Single source for the option doc, the usage message, and _comparators.
my @SORT_FIELDS = qw( id status priority created updated due );

option sort => (
  is => 'ro',
  format => 's',
  default => sub { 'id' },
  doc => 'Sort by: ' . join(', ', @SORT_FIELDS),
);

option reverse => (
  is => 'ro',
  short => 'r',
  doc => 'Reverse sort order',
);

option archived => (
  is => 'ro',
  doc => 'Show only archived tasks',
);

sub execute {
  my ($self, $args_ref, $chain_ref) = @_;
  # "0 task(s)" and `[]` are answers about a board; a repository with no board
  # has to say that instead of borrowing them (#135).
  $self->require_local_board;
  my @tasks = $self->_load_tasks;
  @tasks = $self->_filter(\@tasks);
  @tasks = $self->_sort(\@tasks);

  if ($self->json) {
    # to_json_hash, not to_frontmatter: the body lives below the frontmatter in
    # the file format, so the frontmatter view has no body to give and list
    # --json shipped bodiless cards while show/pick/handoff shipped whole ones
    # (ticket #129). kanban-md marshals the full task here too, with
    # `json:"body,omitempty"` on Body (cmd/list.go, internal/task/task.go).
    $self->print_json([map { $_->to_json_hash } @tasks]);
    return;
  }

  if ($self->compact) {
    for my $t (@tasks) {
      printf "#%-4u %10s %s\n", $t->id, $t->status, $t->title;
    }
    return;
  }

  printf "%-5s %10s %s\n", 'ID', 'STATUS', 'TITLE';
  printf "%s\n", '-' x 72;
  for my $t (@tasks) {
    my @meta;
    push @meta, $t->priority if defined $t->priority && length $t->priority;
    # An `assignee: ""` from kanban-md satisfies the predicate but names
    # nobody, and printing it gave every imported card a bare "@" in its meta
    # list. Empty means absent here as it does in pick (ticket #59).
    push @meta, '@' . $t->assignee if $t->has_assignee && length $t->assignee;
    push @meta, 'blocked' if $t->has_blocked;
    my $title = $t->title;
    $title .= ' [' . join(', ', @meta) . ']' if @meta;

    printf "#%-4u %10s %s\n",
      $t->id,
      $t->status,
      $title;
  }
  printf "\n%d task(s)\n", scalar @tasks;
}

sub _load_tasks {
  my ($self) = @_;
  return $self->load_tasks;
}

sub _filter {
  my ($self, $tasks) = @_;
  my @filtered = @$tasks;

  # Which statuses were asked for, if any. --archived is a status filter and
  # nothing more, exactly as in kanban-md (cmd/list.go): it replaces --status
  # rather than intersecting with it, and every other filter below still
  # applies on top, so `--archived --tag legacy` means what it reads like.
  my $wanted;
  if ($self->archived) {
    $wanted = { App::karr::Config->ARCHIVED_STATUS => 1 };
  } elsif ($self->status) {
    $wanted = { map { $_ => 1 } split /,/, $self->status };
  }

  # Nothing asked for: hide the board's terminal statuses, so the default view
  # is open work. Asked of the store, so a board whose final column is
  # `shipped` hides shipped work instead of the `done` it does not have
  # (ticket #67).
  if ($wanted) {
    @filtered = grep { $wanted->{$_->status} } @filtered;
  } else {
    @filtered = grep { !$self->store->is_terminal_status($_->status) } @filtered;
  }
  if ($self->priority) {
    my %priorities = map { $_ => 1 } split /,/, $self->priority;
    @filtered = grep { $priorities{$_->priority} } @filtered;
  }
  if ($self->assignee) {
    @filtered = grep { $_->has_assignee && $_->assignee eq $self->assignee } @filtered;
  }
  if ($self->tag) {
    @filtered = grep {
      my $t = $_;
      grep { $_ eq $self->tag } @{$t->tags};
    } @filtered;
  }
  if ($self->claimed_by) {
    @filtered = grep { $_->has_claimed_by && $_->claimed_by eq $self->claimed_by } @filtered;
  }
  if ($self->search) {
    my $q = lc($self->search);
    @filtered = grep {
      index(lc($_->title), $q) >= 0