view release on metacpan or  search on metacpan

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

  # > ctx.json` has to leave behind a file that decodes whole, and a
  # key=value rendering that carries one line of prose is not key=value.
  # Without an output flag stdout is prose anyway, so the line stays put.
  if ( $self->json || $self->compact ) {
    printf STDERR "Context written to %s\n", $self->write_to;
  }
  else {
    printf "Context written to %s\n", $self->write_to;
  }
}

sub _task_item {
  my ($self, $task, $note) = @_;
  return {
    id       => $task->id,
    title    => $task->title,
    status   => $task->status,
    priority => $task->priority,
    # Empty means absent, as in pick and list (ticket #59): an `assignee: ""`
    # from kanban-md must not become an "assignee":"" key in the --json
    # payload. The Markdown renderer already tested truth rather than the
    # predicate, so only --json ever saw it.
    ( $task->has_assignee && length $task->assignee
      ? ( assignee => $task->assignee )
      : () ),
    ($note ? (note => $note) : ()),
  };
}

# Cross-agent recent activity (ticket #92). #64 put every mutating command
# through the log, but context read none of it -- the log was still summarised
# purely from task state. Read via the same merged-refs walk `karr log` does,
# but bounded, because this is a briefing meant to stay short, not the log
# viewer: the whole log is what `karr log` is for.
#
# The bound excludes the invoking identity's own entries rather than
# truncating a merged view blindly. An agent about to pick up work already
# knows what it itself just did -- `karr show --me` is the tool for that --
# so what changes its decision is what *other* identities have been doing.
# Only the current-scheme refs are excluded; entries left on a pre-#75 legacy
# ref (see App::karr::ActivityLog) are rare enough, and old enough, that
# counting them as "someone else" costs nothing in practice.
#
# "The current-scheme refs" is plural and asked of the log itself (owns_ref),
# not compared against one ref name: since #171 an identity's log rotates into
# refs/karr/log/<role>/<email>+NNNNNN segments, and an equality test would have
# started reporting this agent's own older entries as another agent's the
# moment its log outgrew one segment.
sub _recent_activity {
  my ($self) = @_;
  my $git = $self->git;
  my $log = $self->activity_log;

  my @entries;
  for my $ref ($git->list_refs('refs/karr/log/')) {
    next if $log->owns_ref($ref);
    my $content = $git->read_ref($ref);
    next unless defined $content && length $content;
    for my $line (split /\n/, $content) {
      next unless length $line;
      my $decoded = eval { json_decode($line) };
      push @entries, $git->maybe_repair_legacy($decoded) if $decoded;
    }
  }

  @entries = sort { ($a->{ts} // '') cmp ($b->{ts} // '') } @entries;
  my $limit = $self->activity_limit;
  @entries = @entries[-$limit .. -1] if $limit && @entries > $limit;

  # Newest first, like recently-completed -- the point of a briefing is that
  # the most relevant items are the ones on top.
  return map {
    my $e = $_;
    {
      ts      => $e->{ts},
      agent   => $e->{agent},
      action  => $e->{action},
      task_id => $e->{task_id},
      ( defined $e->{detail} && length $e->{detail} ? ( detail => $e->{detail} ) : () ),
    }
  } reverse @entries;
}

# The in-progress section is the briefing's "what is being worked on right
# now", sorted most-urgent-first. The order comes from the board's own
# priorities list -- a hardcoded table used to give the wrong answer for any
# priority the default set did not know (ticket #149). Convention matches
# pick / kanban-md: higher index in the list = more urgent.
sub _pri_order {
  my ($self, $task) = @_;
  my @priorities = $self->config->priorities;
  my %index;
  $index{$priorities[$_]} //= $_ for 0 .. $#priorities;
  my $max = $#priorities;
  return $max - ( $index{ $task->priority } // -1 );
}

sub _count_overdue {
  my ($self, $tasks) = @_;
  my $now = gmtime->strftime('%Y-%m-%d');
  return scalar grep { $self->_is_overdue($_, $now) } @$tasks;
}

# One overdue test for the count and the section, so the header can never
# disagree with the list under it.
#
# `due: ""` satisfies the predicate but is not a date, and the empty string
# sorts before every real one -- so a kanban-md card carrying it was reported
# overdue for ever, with "due " and nothing after it. Empty means absent, as it
# does in pick (ticket #59).
sub _is_overdue {
  my ($self, $task, $now) = @_;
  return 0 unless $task->has_due && length $task->due;
  return 0 unless $task->due lt $now;
  return !$self->store->is_terminal_status($task->status);
}

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