App-karr
view release on metacpan or search on metacpan
lib/App/karr/Foundation/Coordinator.pm view on Meta::CPAN
}
sub route {
my ( $self, $repo ) = @_;
my $assignment = $self->assignment;
if ( defined( my $broken = $assignment->{broken} ) ) {
$self->want( reason => $broken );
return undef;
}
my $chain = $assignment->{repos}{ _key($repo) };
unless ( $chain && @$chain ) {
$self->want( repo => "$repo",
reason => 'no assignment names this repository' );
return undef;
}
my $agents = $self->foundation->_agents;
my @failing;
for my $entry ( @$chain ) {
return { wait => 'the assignment says WAIT for this board'
. ( @failing ? ' (after ' . join( ', ', @failing ) . ', which '
. ( @failing == 1 ? 'is' : 'are' ) . ' failing)' : '' ) }
if lc $entry eq $WAIT;
# An agent this machine does not define is dropped with a note rather than
# refused, the way a chain header's per-agent limit is: agent definitions
# are local and only local, so a table written where more of them exist is
# a normal thing to meet, not a broken one.
unless ( $agents->definitions->{$entry} ) {
$self->foundation->_say_verbose(
"assignment: no agent '$entry' is defined here, trying the next" );
next;
}
return { agent => $entry } if $agents->available( $entry );
push @failing, $entry;
}
return { wait => 'every agent the assignment names for this board is failing ('
. join( ', ', @failing ) . ')' } if @failing;
$self->want( repo => "$repo",
reason => 'the assignment names no agent this machine has for this repository' );
return undef;
}
# ---------------------------------------------------------------------------
# Wants
# ---------------------------------------------------------------------------
has wanted => (
is => 'ro',
default => sub { [] },
);
# Which entries have already been recorded, so one tick that meets the same
# deviation twice -- _plan_repos and _process_repo both resolve every board --
# does not say it twice in the prompt.
has _seen => (
is => 'ro',
default => sub { {} },
);
sub want {
my ( $self, %what ) = @_;
return 0 unless $self->configured;
my $reason = $what{reason};
return 0 unless defined $reason && length $reason;
my $key = join "\0", map { defined $what{$_} ? $what{$_} : '' }
qw( step repo reason );
return 0 if $self->_seen->{$key}++;
push @{ $self->wanted }, {
reason => $reason,
( defined $what{step} ? ( step => "$what{step}" ) : () ),
( defined $what{repo} ? ( repo => "$what{repo}" ) : () ),
};
return 1;
}
# One deviation as the prompt says it: what it is about, then what it was.
sub _line {
my ( $want ) = @_;
my $what = defined $want->{step} ? "step $want->{step}"
: defined $want->{repo} ? $want->{repo}
: undef;
return defined $what ? "$what: $want->{reason}" : $want->{reason};
}
# ---------------------------------------------------------------------------
# The call
# ---------------------------------------------------------------------------
sub dispatch {
my ( $self ) = @_;
my @wanted = @{ $self->wanted };
return 0 unless @wanted;
# Emptied first: whatever happens below, this tick has had its one call, and
# a second dispatch must not turn one deviation into two runs.
@{ $self->wanted } = ();
my $f = $self->foundation;
my $name = $self->name or return 0;
my $why = join '; ', map { _line($_) } @wanted;
if ( $f->dry_run ) {
print "would call the coordination agent '$name' for "
. scalar(@wanted) . " deviation(s): $why\n";
return 0;
}
my $git = $f->_hub_git;
unless ( $git ) {
warn "karr-foundation: the coordination agent '$name' is wanted ($why) but "
. "this machine has no hub -- name one with 'hub: /path/to/repo' in "
. $f->_config_path . "\n";
return 0;
}
my $hub = $git->dir;
# An agent like any other, including this: while it is failing, it is not
# run. The place that wanted it waits, which is the behaviour F<karr-foundation>
# had before there was a coordination agent at all, and the wait ends by
# itself when probe_every comes round.
unless ( $f->_agents->available( $name ) ) {
my $av = $f->_agents->availability( $name );
my $wait = ( $av->{next_attempt} // 0 ) - time;
print "the coordination agent '$name' is failing"
. ( defined $av->{last_error} ? " ($av->{last_error})" : '' )
. ", next attempt in ${wait}s -- the plan waits\n";
return 0;
}
unless ( $f->_acquire_lock( $hub ) ) {
print "the coordination agent '$name' is wanted, but the hub $hub is busy "
. "-- the plan waits for the next tick\n";
return 0;
}
print "calling the coordination agent '$name' for " . scalar(@wanted)
. " deviation(s): $why\n";
$f->_append_log( $hub, 'COORDINATION wanted: ' . $why );
my $ran = try {
$self->_invoke( $hub, $name, \@wanted );
} catch {
warn "karr-foundation: the coordination agent failed to start: "
. clean_error($_) . "\n";
0;
};
$f->_release_lock( $hub );
return $ran;
}
# The invocation itself, once the tick has decided it may happen: the agent's
# own command under its own contract (#188), the deviations as its prompt, and
# its own result object as the verdict (#187).
sub _invoke {
my ( $self, $hub, $name, $wanted ) = @_;
my $f = $self->foundation;
my $inv = $f->_agents->invocation( $name );
my ( $exit, $output ) = $f->_run_command(
$hub, $f->_load_karr( $hub ), $inv->{command}, undef, $inv,
role => 'coordinator',
prompt => $self->prompt( $wanted ),
);
my ( $err, $ended );
my $report = $f->_run_result( $output );
if ( $report ) {
( $err, $ended ) = $f->_result_error( $report );
# The same reading the drain makes of an exit the report does not account
# for: the report is the agent's, the exit code may be a wrapper's.
$err //= "exit=$exit" if $exit != 0 && !$report->{is_error};
$f->_append_log( $hub, $f->_result_line( $report, $ended ) );
}
elsif ( $exit != 0 ) {
$err = "exit=$exit";
}
if ( defined $err ) {
$f->_agents->record_failure( $name, $err );
$f->_append_log( $hub, "COORDINATION failed: $err" );
print "the coordination agent '$name' failed: $err\n";
return 0;
}
$f->_agents->record_success( $name );
$f->_append_log( $hub, 'COORDINATION ' . ( $ended // 'done' ) );
print "the coordination agent '$name' finished ("
. ( $ended // 'no report' ) . "); the next tick runs what it wrote\n";
return 1;
}
# ---------------------------------------------------------------------------
# The prompt
# ---------------------------------------------------------------------------
sub prompt {
my ( $self, $wanted ) = @_;
my $f = $self->foundation;
my $hub = $f->_hub_git ? $f->_hub_git->dir : '(none)';
my @out;
push @out, <<'INTRO';
You are the coordination agent of this karr fleet -- its judgement layer.
karr-foundation works through written plans on its own and calls you only when
a plan is missing or has broken; between two of those calls no AI runs at all.
Everything you write is read back by machinery that runs without you, so write
it in the shapes below and in no other.
INTRO
push @out, "WHY YOU WERE CALLED\n"
. join( '', map { ' - ' . _line($_) . "\n" } @$wanted );
push @out, "WHERE THINGS ARE\n"
. sprintf( " fleet config %s\n", $f->_config_path )
. sprintf( " assignment %s\n", $self->assignment_file )
. sprintf( " availability %s (karr writes it; read it, never edit it)\n",
$f->_agents->state_file )
. sprintf( " hub repository %s (refs/karr-foundation/*: chain, run log, questions)\n", $hub )
. " Read a board with 'karr list --compact', 'karr board', 'karr show ID'\n"
. " in its repository, and the fleet with 'karr-foundation --status --verbose'.\n";
push @out, $self->_agent_block;
my $routing = $f->_config_data->{routing};
push @out, "HOW THE OPERATOR WANTS THEM USED\n"
. ( defined $routing && length $routing
? _indent( $routing )
: " Nothing written. The operator can put prose in the config's "
. "'routing:' key.\n" );
push @out, $self->_writes_block;
push @out, <<'LIMITS';
WHAT YOU MUST NOT DO
- Name an agent in a chain step. The chain is shared with every machine in
the fleet and an agent exists on one machine and not on the next; routing
is the assignment's job and the assignment is local.
- Lift a block on a card. A cross-board link is a fact and 'blocked' is a
decision: 'karr needs --resolve' or a person makes it.
- Plan two agents into one repository at the same time. One agent per
repository is the fleet's one hard rule; concurrency is across
repositories.
- Teach karr anything domain-specific. What "done" means for a project, how
a release is verified and which project depends on which reach karr only
through a board's on_drained hook and through the prose above.
LIMITS
return join "\n", @out;
}
# The agents this machine has, with what is known about each right now. The
# description is printed as written: it is the selection criterion, and a
# language model reads prose better than it matches a taxonomy, so nothing
# here reformats or truncates it.
sub _agent_block {
my ( $self ) = @_;
my $agents = $self->foundation->_agents;
my $defs = $agents->definitions;
my @names = sort keys %$defs;
return "THE AGENTS ON THIS MACHINE\n None are defined.\n" unless @names;
my $out = "THE AGENTS ON THIS MACHINE\n";
for my $name ( @names ) {
my $def = $defs->{$name};
$out .= sprintf " %s kind: %s %s%s\n", $name, $def->{kind},
$self->_availability( $name ),
( ( $def->{role} // '' ) eq 'coordinator' ? ' [you]' : '' );
next unless defined $def->{description} && length $def->{description};
my $text = $def->{description};
$text =~ s/\s+\z//;
$out .= " $_\n" for split /\n/, $text;
}
return $out;
}
sub _availability {
my ( $self, $name ) = @_;
my $av = $self->foundation->_agents->availability( $name );
return 'ok' unless ( $av->{state} // 'ok' ) eq 'failing';
return 'failing since ' . _stamp( $av->{failing_since} )
. ', next attempt at ' . _stamp( $av->{next_attempt} )
. ( defined $av->{last_error} ? " ($av->{last_error})" : '' );
}
# The three things it may write, each with the exact shape karr reads back. Two
# of them are commands and are spelled out as commands: an agent that has to
# guess at an interface writes something nobody can execute. Until #213 the
# chain was the exception -- there was no command for it, so this block carried
# a perl -e one-liner against ChainStore, which made a storage API an agent's
# interface and left every rename in that class breaking a prompt instead of a
# call.
sub _writes_block {
my ( $self ) = @_;
my $file = $self->assignment_file;
my $karr = $self->_foundation_command;
return <<"WRITES";
WHAT YOU MAY WRITE
1. THE ASSIGNMENT -- $file
Repository path to the ordered list of agents that may work that board.
karr-foundation takes the first entry that currently works, and WAIT means
"rather wait than use anything further down". Only the names above, plus
WAIT. Name every repository of the fleet: one that is missing calls you
again on the next tick, so a board nothing should run on gets a chain of
its own that is just WAIT.
repos:
/path/to/repo:
- agent-name
- another-agent
- WAIT
2. A CHAIN, in the hub. Keep it short: a long chain goes stale faster than it
is worked through. A step carries id, kind (ticket | shell | question |
plan), repo, ticket, needs (step ids -- the edges of the DAG), timeout,
precheck, command and note. A precheck is '<fact> == <value>' or '!=' over
board_actionable, ticket_status, ticket_blocked, ticket_claimed,
ticket_links and question_state; a step whose precheck no longer holds is
not executed -- it goes stale and calls you again. Write the whole chain as
one YAML (or JSON) document on stdin; it REPLACES the chain that is there,
so it is the plan as you now think it should be, not an addition to it:
$karr plan <<'CHAIN'
steps:
- id: 1
kind: ticket
repo: /path/to/repo
ticket: 7
precheck: ticket_status == todo
- id: 2
kind: shell
repo: /path/to/repo
needs: [ 1 ]
command: ./gate.sh
limits:
concurrent: 2
note: what this plan is for
CHAIN
Add --dry-run to have a chain checked and told back to you without writing
it. A chain that still has a step running is refused rather than replaced;
--force replaces it anyway, and is not what you want unless you know what
that step was doing.
3. A QUESTION, always in advance and never from inside a step:
$karr ask "which registry do we publish to?" \\
--context "the release gate is waiting" \\
--options cpan,darkpan --default cpan --policy use_default \\
--wait 3600 --step 2
lib/App/karr/Foundation/Coordinator.pm view on Meta::CPAN
my $routed = $coordinator->route( $repo );
# undef -- nothing routes this board; resolve it as before
# { agent => 'minimax' } -- the first agent in its chain that works
# { wait => 'why' } -- its chain says wait; no agent runs here now
What the assignment says about one repository. This is the hot path: a lookup
and an availability check, with no AI anywhere in it.
The first entry that names a defined and currently available agent wins. A
C<WAIT> entry ends the search -- "rather wait than use anything further down"
is the one thing an ordered list cannot say by itself -- and so does a chain
whose agents are all failing, because the coordination agent wrote that chain
and going past its end would be karr routing on its own.
A repository the table does not name, or names with nothing usable, is the
fourth deviation: it records that the coordination agent is wanted (L</want>)
and returns C<undef>, so resolution carries on exactly as it did before --
C<default_agent>, C<< claude: true >>, or no agent at all.
=head2 wanted
The deviations recorded so far this tick, in the order they were seen, each
C<< { reason => ..., step => ..., repo => ... } >>. L</dispatch> empties it.
=head2 want
$coordinator->want( step => 4, reason => 'kind: plan is not executed here' );
$coordinator->want( repo => "$repo", reason => 'no assignment names it' );
Records that the coordination agent is wanted, and returns true when it was
recorded. A B<no-op> for a fleet that marks no coordinator: the caller has
already said what it wanted out loud and written it into its own log, and this
class refuses to be a second such record when nobody can act on it.
Identical entries collapse, which is what makes one tick one call.
=head2 dispatch
$coordinator->dispatch;
The one call a tick may make. Returns true when the coordination agent ran.
Nothing happens without a deviation, without a coordinator, or without a hub:
the agent's outputs -- a chain, a question -- live in
C<refs/karr-foundation/*>, so a fleet with no hub has nowhere to put them, and
that is said once rather than worked around.
The run happens B<in the hub> and B<under the hub's own> F<.karr.lock>, which
is the same rule every other run here obeys: one agent per repository, however
many ticks knock. It carries C<KARR_ROLE=coordinator>, so whatever C<karr>
writes it makes land in their own activity log instead of counting as a board
agent's engagement with a card (#158).
Its result decides the agent's availability exactly as a drain's does: a
reported error or a non-zero exit marks it C<failing> and every board on it
waits for one probe interval, anything else says it works. The transcript is
B<not> scanned. That scan exists for a board run that moved nothing and
printed a rate limit (#160); this run moves no board by definition, and a
planner that prints a backlog would trip it on the backlog's own words.
=head2 prompt
my $text = $coordinator->prompt( \@wanted );
The instruction the coordination agent is given, as C<$PROMPT>: why it was
called, where the fleet's files are, which agents exist here with their
availability and their prose, the operator's own prose about how to use them
(config key C<routing:>), the shapes it may write, and the boundaries it may
not cross.
There is deliberately no key to replace this text with another. What an
operator has to say about routing is prose and belongs in C<routing:>, where
the agent reads it in context; a second prompt key would be a place to
overwrite the part that says what karr can actually read back.
=head1 SUPPORT
=head2 Issues
Please report bugs and feature requests on GitHub at
L<https://github.com/Getty/karr/issues>.
=head2 IRC
Join C<#langertha> on C<irc.perl.org> or message Getty directly.
=head1 CONTRIBUTING
Contributions are welcome! Please fork the repository and submit a pull request.
=head1 AUTHOR
Torsten Raudssus <getty@cpan.org>
=head1 COPYRIGHT AND LICENSE
This software is Copyright (c) 2026 by Torsten Raudssus <torsten@raudssus.de> L<https://raudssus.de/>.
This is free software, licensed under:
The Artistic License 2.0 (GPL Compatible)
=cut
( run in 0.296 second using v1.01-cache-2.11-cpan-aadc1410aed )