view release on metacpan or  search on metacpan

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

# would be exactly the silent frontmatter deletion of ticket #69. Only an
# explicit unblock throws the reason away.
sub _set_blocked_flag {
  my ( $self, $value ) = @_;
  return $value ? $self->blocked(!!1) : $self->clear_blocked;
}

sub block {
  my ( $self, $reason ) = @_;
  $self->blocked(!!1);
  if ( defined $reason && length $reason ) {
    $self->block_reason($reason);
  } else {
    $self->clear_block_reason;
  }
  return $self;
}


sub unblock {
  my ($self) = @_;
  $self->clear_blocked;
  $self->clear_block_reason;
  return $self;
}


# kanban-md's AppendBody (internal/board/mutate.go:571): the trailing newlines
# come off the existing body and the two halves are joined with a blank line.
# karr joined with a single "\n" until ticket #238, and Markdown folds a single
# newline into a space -- so every note appended by `karr edit -a` or
# `karr handoff --note` was rendered into the paragraph above it, and a card
# that collected notes over a session ended up as one block.
#
# Emptiness is measured *after* the trim, which is where this parts company with
# the reference: Go tests `existing != ""` first, so a body that is nothing but
# newlines still gets the separator and comes back with a leading blank line.
# That body cannot arrive from the board -- _parse_content strips trailing
# newlines, the normal form ticket #78 settled -- but it can arrive from a
# caller in process, and "an empty body gains no separator" is the whole point
# of the branch. Only newlines are trimmed, never other whitespace: an indented
# last line is content.
#
# length, not truth, on the trimmed body: appending to a body of "0" must
# preserve it (ticket #78).
sub append_body {
  my ( $self, $text, $timestamp ) = @_;
  # The handoff form, deliberately not kanban-md's: karr writes every stamp in
  # UTC (App::karr::Role::ClaimTimeout says why), and `[[2006-01-02]]` is
  # wiki-link syntax that means nothing here. Opt-in at both call sites -- an
  # inline prefix would turn `-a "## Findings"` into a line that is no longer a
  # heading, so it cannot be forced on every append.
  $text = gmtime->strftime('%Y-%m-%d %H:%M') . ' ' . $text if $timestamp;
  my $body = defined $self->body ? $self->body : '';
  $body =~ s/\n+\z//;
  $self->body( length $body ? $body . "\n\n" . $text : $text );
  return $self;
}


sub update_timestamps {
  my ( $self, $old_status, $new_status, $first_status, $config ) = @_;
  my $now = gmtime->datetime . 'Z';

  # Called on the class, is_terminal_status answers for the default board --
  # the literal `done` and `archived`. That is all this method could ever ask
  # before the last #67 leftover fell, so a board whose final column is named
  # anything else recorded no completion at all: `karr move 1 shipped` stamped
  # `started` and left `completed` unset for ever, and every reader built on
  # it (metrics, context's recently-completed) saw an empty set. Hand the
  # board's own App::karr::Config in and its statuses decide instead.
  $config //= 'App::karr::Config';

  # First move out of the board's first status starts the clock, and never
  # restarts it.
  if ( !$self->has_started
    && defined $first_status
    && defined $old_status
    && $old_status eq $first_status
    && $new_status ne $first_status )
  {
    $self->started($now);
  }

  if ( $config->is_terminal_status($new_status) ) {
    $self->completed($now) unless $self->has_completed;
    # A task dragged straight to done never passed through in-progress, so it
    # has no start; without this its cycle time would be unmeasurable.
    $self->started($now) unless $self->has_started;
  } elsif ( defined $old_status
    && $config->is_terminal_status($old_status) )
  {
    # Reopening. `started` is deliberately kept: the work did begin then.
    $self->clear_completed;
  }

  return $self;
}


sub slug {
  my ($self) = @_;
  my $slug = lc($self->title);
  $slug =~ s/[^a-z0-9]+/-/g;
  $slug =~ s/^-|-$//g;
  return $slug if length($slug) <= MAX_SLUG_LENGTH;

  # Truncate on a word boundary the way kanban-md's GenerateSlug does
  # (internal/task/slug.go): cutting mid-word backs up to the last dash, and a
  # cut that already landed on one keeps the whole final word. A hard cut at 50
  # gave the same task two different filenames in a shared tasks/ directory.
  my $truncated = substr( $slug, 0, MAX_SLUG_LENGTH );
  if ( substr( $slug, MAX_SLUG_LENGTH, 1 ) ne '-' ) {
    my $idx = rindex( $truncated, '-' );
    $truncated = substr( $truncated, 0, $idx ) if $idx > 0;
  }
  $truncated =~ s/-+\z//;
  return $truncated;
}