locked results from the CPAN

App-karr

  for my $repo ( @repos ) {
    my $key = try { $repo->realpath } catch { $repo->absolute };
    next if $seen{$key}++;
    push @uniq, $repo;
  }
  return @uniq;
}

# True when $dir is *itself* the root of a karr-init'd repo â€” resolves via
# libgit2 so packed refs (git gc / pack-refs) and worktree gitdir indirection
# are handled, unlike a bare .git/refs/karr/config file check. libgit2's
# open_ext walks up to find an enclosing .git, so a plain directory nested
# inside a karr repo would spuriously match; guard by confirming the resolved
# repo root is $dir, not an ancestor.
sub _is_karr_board_root {
  my ( $self, $dir ) = @_;
  my $git = App::karr::Git->new( dir => "$dir" );
  return 0 unless $git->is_repo;
  my $root = $git->repo_root or return 0;
  return 0 unless $root->realpath eq path( $dir )->realpath;
  return $git->ref_exists('refs/karr/config');
}

# ---------------------------------------------------------------------------
# Per-repo processing
# ---------------------------------------------------------------------------

sub _process_repo {
  my ( $self, $repo ) = @_;

  # Check if repo has karr board (either .karr file or karr refs). Resolve the
  # ref via libgit2 so packed refs and worktrees are handled â€” $repo is an
  # already-known repo root here, so open_ext's walk-up cannot false-match.
  my $has_karr = $repo->child('.karr')->exists
              || App::karr::Git->new( dir => "$repo" )->ref_exists('refs/karr/config');
  unless ( $has_karr ) {
    $self->_say_verbose("skip $repo \x{2014} no karr board");
    return;
  }

  # Board-level disable flag, checked FIRST: before the agent command is even
  # resolved and before the drain decision. A disabled board is skipped whole â€”
  # no drain, no auto-block, no agent run â€” so the flag wins over --command,
  # the config's default_command, the .karr command and 'claude: true'. It is
  # deliberately absolute: --force does not override it.
  return if $self->_skip_disabled( $repo );

  my $karr = $self->_load_karr( $repo );

  # Resolve the agent command (CLI > default_command > .karr command >
  # claude: true synthesis). Agent execution is opt-in: a board with no agent
  # is shown in the overview, not run.
  my $cmd = $self->_agent_command( $repo, $karr );
  unless ( defined $cmd ) {
    $self->_say_verbose("skip $repo \x{2014} no agent configured (see --status)");
    return;
  }

  # Check lock â€” skip if another instance is running
  if ( $self->_lock_held( $repo ) ) {
    $self->_say_verbose("skip $repo \x{2014} locked by running agent");
    return;
  }

  # Respect exponential cooldown left by a previous common-error run
  if ( $self->_cooldown_active( $repo ) ) {
    my $until = $self->_state_get( $repo, 'cooldown_until' ) // 0;
    $self->_say_verbose( "skip $repo \x{2014} in cooldown for " . ( $until - time ) . "s" );
    return;
  }

  # Pull latest refs. A pull that refuses -- the wholesale-wipe guard, the
  # board-identity guard, and (since #154) the unapplied-refs guard all die
  # rather than return false -- must not abort the drain loop. The other
  # per-repo step that can die (_drain_repo below) is wrapped in its own
  # try and turned into a structured error result; the pull sits at the same
  # level and is isolated the same way, so a refusal from one board warns
  # and is skipped here while the rest of run() continues to the next.
  # The pull happens before the lock is taken, so "release whatever it
  # holds" is a no-op today; the wrap is for the structural isolation
  # (clean separation, karr-shaped error message) and is forward-compatible
  # with any future caller that takes the lock before pulling.
  my $pull_ok = try {
    $self->_sync_pull( $repo );
    1;
  } catch {
    warn "karr-foundation: pull error in $repo: $_\n";
    0;
  };
  return unless $pull_ok;

  # The pull may have just brought the disable flag in from another machine â€”
  # re-check before committing to a drain, so a board disabled elsewhere is
  # never drained even once by this host.
  return if $self->_skip_disabled( $repo );

  # Decide whether to start a drain at all
  my $should_run = $self->force;
  unless ( $should_run ) {
    my $prev_hash = $self->_state_get( $repo, 'hash' ) // '';
    my $curr_hash = $self->_ref_hash( $repo ) // '';
    my $on_idle   = $karr->{on_idle} // 'skip';
    $should_run = ( $curr_hash ne $prev_hash )
               || $self->_has_actionable_tasks( $repo )
               || ( $on_idle eq 'always-run' );
  }

  unless ( $should_run ) {
    $self->_say_verbose("skip $repo \x{2014} no board change and no actionable tasks");
    return;
  }

  # Acquire lock â€” flock-based now, so two ticks that overlap race on the
  # file rather than on a check-then-act gap a git pull apart (#162). Failure
  # here means another foundation instance holds the board; we skip and move
  # on instead of spewing over the existing lock.
  unless ( $self->_acquire_lock( $repo ) ) {
    $self->_say_verbose("skip $repo \x{2014} lock contended (another tick holds it)");
    return;
  }
  my $result = try {

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

# ---------------------------------------------------------------------------
# Sync
# ---------------------------------------------------------------------------

sub _sync_pull {
  my ( $self, $repo ) = @_;
  $self->_say_verbose("sync --pull $repo");
  return if $self->dry_run;
  my $git = App::karr::Git->new( dir => "$repo" );
  return unless $git->is_repo;
  $git->pull;
}

# ---------------------------------------------------------------------------
# Ref hash (detect board changes)
# ---------------------------------------------------------------------------

sub _ref_hash {
  my ( $self, $repo ) = @_;
  my $git = App::karr::Git->new( dir => "$repo" );
  return undef unless $git->is_repo;
  my $oids = $git->ref_oids('refs/karr/') or return undef;
  # Deterministic fingerprint of refs/karr/* (ref name + target OID).
  my $out = join '', map { "$_ $oids->{$_}\n" } sort keys %$oids;
  return md5_hex( $out );
}

# ---------------------------------------------------------------------------
# Board-level disable flag (refs/karr/config: foundation.enabled)
# ---------------------------------------------------------------------------

# The board's own opt-out, stored in karr state rather than in the local .karr
# file so it syncs with the board and every foundation instance on every machine
# honours it. Returns { reason => $text_or_undef } when the board is disabled
# and undef when it is enabled (the default for a board that never set it).
sub _board_disabled {
  my ( $self, $repo ) = @_;
  my $git = App::karr::Git->new( dir => "$repo" );
  return undef unless $git->is_repo;
  my $store = App::karr::BoardStore->new( git => $git );
  return undef if $store->foundation_enabled;
  return { reason => $store->foundation_reason };
}

# Skip predicate used at the two checkpoints in _process_repo. True (and a
# verbose note) when the board is disabled.
sub _skip_disabled {
  my ( $self, $repo ) = @_;
  my $off = $self->_board_disabled( $repo ) or return 0;
  my $reason = $off->{reason};
  $self->_say_verbose(
    "skip $repo \x{2014} board disabled" . ( defined $reason ? ": $reason" : '' ) );
  return 1;
}

# ---------------------------------------------------------------------------
# Task state / actionability
# ---------------------------------------------------------------------------

# A task is actionable when an agent could still pick it: not terminal
# (done/archived) and not blocked. Mirrors `karr pick` eligibility.
sub _is_actionable {
  my ( $self, $st ) = @_;
  return 0 unless $st;
  return 0 if $st->{blocked};
  my $status = $st->{status} // '';
  return 0 if $status eq 'done' || $status eq 'archived';
  return 1;
}

# Snapshot every task as id => { status, claimed_by, updated, blocked }.
sub _task_states {
  my ( $self, $repo ) = @_;
  my $git = App::karr::Git->new( dir => "$repo" );
  return () unless $git->is_repo;
  my $store = App::karr::BoardStore->new( git => $git );
  my %states;
  for my $t ( $store->load_tasks ) {
    next unless $t;
    $states{ $t->id } = {
      status     => $t->status,
      claimed_by => ( $t->has_claimed_by ? $t->claimed_by : undef ),
      updated    => $t->updated,
      blocked    => ( $t->has_blocked ? 1 : 0 ),
    };
  }
  return %states;
}

sub _has_actionable_tasks {
  my ( $self, $repo ) = @_;
  my %states = $self->_task_states( $repo );
  for my $id ( keys %states ) {
    return 1 if $self->_is_actionable( $states{$id} );
  }
  return 0;
}

# ---------------------------------------------------------------------------
# Agent engagement (who this run's agent is, and what it touched)
# ---------------------------------------------------------------------------

# The activity log of the identity foundation runs its agent under. The Runner
# exports KARR_ROLE=agent to the command, so every nested `karr` write during
# the run lands in refs/karr/log/agent/<git-email> â€” the same identity this
# builds, since the agent runs in this repo with this repo's git config. Any
# other actor on the board (a human, another machine's agent) writes elsewhere.
sub _agent_log_entries {
  my ( $self, $repo ) = @_;
  my $git = App::karr::Git->new( dir => "$repo" );
  return () unless $git->is_repo;
  my $log = App::karr::ActivityLog->new( git => $git, role => 'agent' );
  return try { $log->entries } catch { () };
}

# An engagement record for one drain: the log entries already present when the
# drain started (so only what this drain adds counts), the task ids this run's
# agent has written to, and the claim names it wrote them under.
sub _new_engagement {
  my ( $self, $repo ) = @_;
  my @seen = $self->_agent_log_entries( $repo );
  return { seen => scalar @seen, ids => {}, claims => {} };
}

# Fold the entries the last command added into the record. Nothing else is
# evidence of engagement: a task that never shows up here was never touched by
# this run's agent, whatever its status or claim says.
sub _note_engagement {
  my ( $self, $repo, $eng ) = @_;
  my @entries = $self->_agent_log_entries( $repo );
  return $eng if @entries <= $eng->{seen};
  for my $entry ( @entries[ $eng->{seen} .. $#entries ] ) {
    my $id = $entry->{task_id};
    $eng->{ids}{ $id + 0 } = 1 if defined $id && $id =~ /\A[0-9]+\z/;
    my $who = $entry->{agent};
    $eng->{claims}{$who} = 1 if defined $who && length $who;
  }
  $eng->{seen} = scalar @entries;
  return $eng;
}

# True when the card is the agent's to penalize: unclaimed, or held under a
# name this run's agent itself wrote with. A claim belonging to anybody else â€”
# a human, another machine's agent, or this agent's own abandoned claim from an

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

    last if !$first && !@actionable;
    last if !$first && $max_runtime > 0 && ( time - $loop_start ) >= $max_runtime;
    last if $iter >= $max_iter;

    my $hash_before = $self->_ref_hash( $repo ) // '';
    my ( $exit, $output ) = $self->_run_command( $repo, $karr, $cmd );
    $last_exit = $exit;
    $first     = 0;
    $iter++;

    my $hash_after = $self->_ref_hash( $repo ) // '';
    my $progressed = ( $hash_before ne $hash_after ) ? 1 : 0;

    # Common error we can observe (bad exit, timeout, or a known output
    # pattern): don't penalize any task â€” leave the board untouched and back
    # off. What the run *did* is asked before what it *printed* (#160): a run
    # that exited 0 and moved the board did work, whatever text went past on
    # the way, and re-reading its own transcript is the one way to lose that
    # work â€” the drain aborted, the progress was credited to nobody, and the
    # cooldown climbed on every following run because the board still said the
    # same words. So the output is evidence only where there is nothing else:
    # a run that produced no board movement at all. The genuine case the scan
    # exists for looks exactly like that, because an agent that hit a rate
    # limit or a dead key could not move anything.
    my $err;
    if ( $exit != 0 ) {
      $err = "exit=$exit";     # or -1, the timeout â€” a hard signal, no scan
    }
    else {
      my $seen = $self->_match_error( $output, $patterns );
      if ( defined $seen && $progressed ) {
        # Worth saying once: an agent that reports a rate limit and still gets
        # a card moved is on its last legs, and the operator should hear it
        # from the log rather than from the next run's cooldown.
        $self->_append_log( $repo,
          "NOTE '$seen' in output, but the board moved \x{2014} not treated as an error" );
      }
      else {
        $err = $seen;
      }
    }

    if ( defined $err ) {
      # An exit-0 run that is thrown away is the surprising one; .karr.state
      # would otherwise carry last_exit: 0 next to last_error with nothing
      # anywhere saying why the run did not count.
      my $why = $exit == 0 ? " \x{2014} agent exited 0, run discarded" : '';
      $self->_append_log( $repo, "COMMON-ERROR $err$why" );
      $self->_state_set( $repo, last_error => $err );
      $outcome = 'common-error';
      last;
    }

    $outcome = 'progress' if $progressed;

    my %after = $self->_task_states( $repo );
    $self->_note_engagement( $repo, $eng );
    my @stuck = $self->_stuck_tasks( \%before, \%after, $eng );

    # Reset the attempt counter for any task that is no longer stuck
    # (advanced, blocked, or gone), then bump/auto-block the stuck ones.
    my %is_stuck = map { $_ => 1 } @stuck;
    my $attempts = $self->_state_get( $repo, 'attempts' ) // {};
    $self->_reset_attempts( $repo, $_ ) for grep { !$is_stuck{$_} } keys %$attempts;

    for my $id ( @stuck ) {
      my $n = $self->_bump_attempts( $repo, $id );
      next if $n < $max_attempts;
      $self->_autoblock_task( $repo, $id,
        "auto-block: no progress after $n attempts (foundation)",
        $eng->{claims} );
      $self->_reset_attempts( $repo, $id );
    }

    # Agent did nothing useful and grabbed nothing â€” stop, nothing to attribute.
    if ( !$progressed && !@stuck ) {
      $outcome = 'idle';
      last;
    }

    last unless $drain;   # drain disabled â†’ single run
  }

  return { outcome => $outcome, exit => $last_exit };
}

# ---------------------------------------------------------------------------
# Auto-block (in-process via BoardStore, no karr CLI)
# ---------------------------------------------------------------------------

# $claims is the set of claim names this run's agent wrote under (see
# _note_engagement). The ownership test is repeated here, at the write itself,
# rather than trusted from _stuck_tasks: this is the one place that mutates
# somebody's card and pushes it, the board may have changed since the snapshot
# the caller decided on, and any future caller inherits the guarantee instead
# of having to remember it (#158).
sub _autoblock_task {
  my ( $self, $repo, $id, $reason, $claims ) = @_;
  return if $self->dry_run;
  my $git = App::karr::Git->new( dir => "$repo" );
  return unless $git->is_repo;
  my $store = App::karr::BoardStore->new( git => $git );
  my $task  = $store->find_task( $id ) or return;
  unless ( $self->_agent_holds(
      { claimed_by => ( $task->has_claimed_by ? $task->claimed_by : undef ) },
      $claims ) ) {
    $self->_append_log( $repo,
      "AUTOBLOCK-SKIP task#$id: claimed by " . $task->claimed_by );
    return 0;
  }
  $task->block( $reason );
  $store->save_task( $task );
  $git->push;   # best-effort propagate to remote
  $self->_append_log( $repo, "AUTOBLOCK task#$id: $reason" );
  return 1;
}

# ---------------------------------------------------------------------------
# Log file
# ---------------------------------------------------------------------------

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

    karr-foundation --dry-run --verbose

    # Read-only overview of every board (no agent runs)
    karr-foundation --status

=head1 DESCRIPTION

F<karr-foundation> is a single-shot, idempotent CLI meant to be invoked
periodically (cron, systemd-timer, while-loop). It scans configured karr
boards, detects changes or open work, and B<drains> each board by invoking the
configured agent command repeatedly until no actionable task remains.

B<Config file:> C<~/.config/karr-foundation/config.yml> (or C<--config>).

  dirs:
    - /path/to/repo1
    - /path/to/repo2

  scan:
    - /path/to/parent-dir   # finds all direct subdirs that have a .karr file

B<Per-repo .karr file:>

  claude: true              # synthesize the canonical claude command (opt-in)
  claude_bin: claude        # binary for claude: true (default: claude)
  claude_max_turns: 30      # --max-turns for claude: true (default: 30)
  claude_permission_mode: bypassPermissions   # (default: bypassPermissions)
  prompt: >-                # agent instruction, exposed as $PROMPT
    Use the karr-coordinator skill: pick the next actionable task and move it.
  command: claude -p "$PROMPT"   # explicit command; wins over claude: true
  on_idle: skip             # 'skip' (default) | 'always-run'
  max_runtime: 1800         # seconds: per-command SIGKILL (0 = no limit)
  drain: true               # loop until drained (default) | false for single run
  max_attempts: 2           # stalls on one task before auto-block (default: 2)
  max_iterations: 50        # hard cap on drain iterations (default: 50)
  cooldown_base: 1          # cooldown minutes at level 0 (default: 1)
  cooldown_max: 64          # cooldown ceiling in minutes (default: 64)
  error_patterns:           # extra case-insensitive substrings â†’ common-error
    - my custom api error   # (added to the defaults; matched as written)

C<claude>, C<claude_bin>, C<claude_max_turns>, C<claude_permission_mode>,
C<command> and C<prompt>/C<default_prompt> may also be set globally in the
config file; the per-repo F<.karr> value wins.

B<Board-level disable.> A board can opt out of automated agent runs in its own
karr state â€” C<foundation.enabled> in C<refs/karr/config>, set with
C<karr disable [--reason "why"]> and cleared with C<karr enable>. Because the
flag is board state it syncs with the board, so every foundation instance on
every machine honours it. A disabled board is skipped B<whole>: the flag is
checked before the agent command is resolved and before the drain decision, so
there is no drain, no auto-block and no agent run. It therefore wins over
C<--command>, the config's C<default_command>, the F<.karr> C<command> and
C<< claude: true >>, and C<--force> does B<not> override it. Use it for a
repository whose backlog is parked (an abandoned project kept for reference)
that a globally configured C<default_command> would otherwise drain. C<--status>
shows such a board with a C<disabled> flag and its reason.

B<Coordinator and overview.> Agent execution is opt-in â€” a board runs an agent
only via C<command> or C<< claude: true >>. When B<no> board has an agent
configured, the default action is a read-only B<overview> of every board
(status counts, in-progress/blocked tasks, lock and cooldown state); a human
can use foundation purely to coordinate their own work. C<--status> forces the
overview regardless of configuration.

B<Live output.> When run interactively (TTY) or with C<--verbose>, the agent's
output is streamed to the terminal in real time as foundation reads it; it is
always appended to F<.karr.log> regardless of TTY. To shape what is shown, the
command may emit stream-json and filter it, e.g.:

  command: >-
    claude -p "$PROMPT"
      --output-format stream-json --verbose --include-partial-messages
      --permission-mode bypassPermissions --max-turns 10
    2>&1 | jq -r 'select(.type == "stream_event") | .event.delta.text // empty'

Set C<max_runtime: 0> in F<.karr> to disable the per-run timeout entirely
(agent runs until completion with no SIGKILL).

B<Drain semantics.> Each iteration runs C<command> once, then classifies the
result from what foundation can observe â€” exit code, board ref movement, and
the run's captured output:

=over 4

=item * B<progress> â€” the board changed; keep draining.

=item * B<stall> â€” a task B<this run's agent engaged> did not move. That task's
attempt counter is bumped; at C<max_attempts> it is auto-blocked
(C<blocked: auto-block: no progress after N attempts (foundation)>) so it drops
out of the actionable set and the drain can finish. The agent may always set a
better reason itself with C<karr edit --block>; the auto-block is a fallback.

B<Engaged> means foundation can prove the agent worked on that card during
B<this> drain: the agent runs with C<KARR_ROLE=agent>, so every C<karr> write
it makes is recorded in the board's own activity log under the C<agent>
identity, and only the tasks named there â€” held by nobody, or by a claim name
the agent itself wrote under â€” can be penalized. A card somebody else holds is
never touched, and neither is one the agent merely left claimed in an earlier
run: a stale claim is what C<claim_timeout> and C<karr unlock> are for. Where
that evidence is missing altogether â€” an agent that does not write through
C<karr>, an unreadable log â€” foundation auto-blocks B<nothing> rather than
guess: the drain then simply ends on its iteration cap, which is far cheaper
than blocking a human's in-progress card out from under them (#158).

=item * B<common-error> â€” a non-zero/timeout exit, or an error pattern in the
output of a run that moved B<nothing> (rate limit, auth, network, 5xx, â€¦). No
task is penalized; the repo enters an exponential cooldown (C<cooldown_base> Ã—
2^level minutes, capped at C<cooldown_max>, reset on the next clean run) and is
skipped until it expires.

What the run did is asked before what it printed: a run that exited 0 and moved
the board is progress whatever text scrolled past, and is never reclassified by
its own transcript. The scan is evidence only where there is no other â€” a run
that produced no board movement at all, which is what a rate-limited or
unauthenticated agent looks like. A pattern seen in a run that B<did> move the
board is noted in F<.karr.log> and otherwise ignored.

The default patterns are correspondingly narrow: a symptom word counts next to
a failure word on the same line ("network error", "invalid credentials",
"quota exceeded"), not on its own, and an HTTP status counts only where
something adjacent marks it as one ("API error: 429", "429 Too Many Requests"),
not in a diffstat or a line number. Before this, an agent that printed its own
board tripped the scan on a backlog title, and a diffstat of 403 changed lines
tripped it on C<403> (#160).

=item * B<idle> â€” the agent did nothing and grabbed nothing; stop.

=back

All state files are gitignored: C<.karr.state> (board hash, per-task attempts,
cooldown, last error), C<.karr.lock>, C<.karr.log>. C<last_error> describes the
B<last> run and is removed again by the next run that is not a common error, so
it never outlives the cooldown it caused.

=head2 run

    exit App::karr::Foundation->new_with_options->run;

The single entry point, invoked by F<bin/karr-foundation>. One pass over
every configured repo, then returns -- there is no internal loop; running
periodically is left to cron/systemd-timer/an external C<while> loop, per
L</DESCRIPTION>. Returns C<1> (a process exit code, not an exception) when
C<_discover_repos> finds nothing at all -- an empty C<dirs>/C<scan> in the
config, or a config file that does not exist -- and C<0> otherwise, including
when individual repos error out: a repo whose C<_process_repo> dies is
C<warn>ed and skipped, never propagated, so one broken board cannot stop the
rest of the run.

With C<--status> it prints L<App::karr::Foundation::Overview>'s read-only

( run in 1.619 second using v1.01-cache-2.11-cpan-788537b7465 )