view release on metacpan or  search on metacpan

t/185-foundation-ticket-mode.t  view on Meta::CPAN

  # The crashed-agent case the mode exists for: a claim older than the board's
  # claim_timeout no longer holds the card, or a board whose last open ticket
  # carries one would go quiet for ever -- nothing would run, so nothing would
  # ever reap the claim.
  my $store = App::karr::BoardStore->new(
    git => App::karr::Git->new( dir => "$repo" ) );
  my $stale = $store->find_task( 5 );
  $stale->claimed_at( gmtime( time - 7200 )->datetime . 'Z' );
  $store->save_task( $stale );

  is $f->_select_ticket( $repo ), 5,
    'an expired claim is taken over, and critical outranks high';
};

# ---------------------------------------------------------------------------
# Unit: how the assignment reaches the agent
# ---------------------------------------------------------------------------

subtest 'the ticket travels in $PROMPT and $KARR_TASK' => sub {
  my $f = App::karr::Foundation->new( _config_data => {} );

  my $plain = $f->_prompt_for( {} );
  unlike $plain, qr/task for this run/, 'no assignment without a ticket';

  my $assigned = $f->_prompt_for( {}, 42 );
  like $assigned, qr/task for this run is #42/, 'the id is in the prompt';
  unlike $assigned, qr/pick the next actionable task/,
    'the built-in default no longer tells the agent to choose its own work';

  my $custom = $f->_prompt_for( { prompt => 'CUSTOM' }, 42 );
  like $custom, qr/\ACUSTOM\n\nThe task for this run is #42/,
    'a configured prompt is kept, with the assignment appended after it';

  my $rdir = tempdir( CLEANUP => 1 );
  my ( undef, $out ) = $f->_run_command( $rdir, {}, 'printf "[%s]" "$KARR_TASK"' );
  is $out, '[]', 'KARR_TASK is empty outside ticket mode';
  my ( undef, $out2 ) = $f->_run_command( $rdir, {}, 'printf "[%s]" "$KARR_TASK"', 7 );
  is $out2, '[7]', 'and carries the id in it';
};

# Ticket #281 / ADR 0005: the runner exports KARR_CLAIM into the child, so
# every nested `karr` the agent spawns defaults its claim to the same name.
# The value is `karr agent-name --unique` for this checkout -- the checkout's
# own directory name plus a per-run suffix, minted once and stable for the run.
subtest 'the claim name travels in $KARR_CLAIM' => sub {
  my $f = App::karr::Foundation->new( _config_data => {} );

  my $rdir = tempdir( CLEANUP => 1 );
  my $base = agent_name( dir => "$rdir" );   # same checkout, no suffix
  ok length $base, 'the checkout has a claim-safe base name';

  my ( undef, $out ) = $f->_run_command( $rdir, {}, 'printf "[%s]" "$KARR_CLAIM"' );
  like $out, qr/\A\[\Q$base\E-[a-z0-9]{3}\]\z/,
    'KARR_CLAIM is the checkout name with a per-run suffix';

  # Minted once per child and inherited by every nested call: the two reads a
  # single run makes see one value, not a fresh one each time.
  my ( undef, $twice ) =
    $f->_run_command( $rdir, {}, 'printf "[%s][%s]" "$KARR_CLAIM" "$KARR_CLAIM"' );
  like $twice, qr/\A\[(\Q$base\E-[a-z0-9]{3})\]\[\g{1}\]\z/,
    'the same value within one run, not re-minted per reference';
};

# ---------------------------------------------------------------------------
# Integration: one run, one ticket, and back
# ---------------------------------------------------------------------------

subtest 'ticket mode runs the agent once, on the card it named' => sub {
  my $repo = make_git_repo();
  seed_board( $repo,
    { status => 'todo', priority => 'low' },
    { status => 'todo', priority => 'high' },
    { status => 'todo', priority => 'low' },
  );
  my $agent = write_fake_agent( $repo );

  my $f = App::karr::Foundation->new( _config_data => {} );
  local $ENV{KARR_FAKE_MODE} = 'assigned';
  my $res = $f->_drain_repo( $repo,
    { command => $agent, max_runtime => 60, mode => 'ticket' } );

  is $res->{ticket},  2,          'the run reports which ticket it was about';
  is $res->{outcome}, 'progress', 'the ticket moved';

  my @runs = runs_of( $repo );
  is scalar @runs, 1, 'exactly one agent run, board still actionable or not';
  is $runs[0], '2', 'the agent was handed the id foundation picked';

  is task_by_id( $repo, 2 )->status, 'done', 'the assigned card is done';
  is task_by_id( $repo, 1 )->status, 'todo', 'the rest of the board is untouched';
  is task_by_id( $repo, 3 )->status, 'todo', 'no drain happened';

  like path( $repo )->child('prompt.txt')->slurp_utf8, qr/task for this run is #2/,
    'the prompt the agent saw named the card';
};

# ---------------------------------------------------------------------------
# Integration: nothing to assign is not a reason to start an agent
# ---------------------------------------------------------------------------

subtest 'no assignable card means no agent run at all' => sub {
  my $repo = make_git_repo();
  seed_board( $repo, { status => 'done' }, { status => 'todo', blocked => 'why' } );
  my $agent = write_fake_agent( $repo );

  my $f = App::karr::Foundation->new( _config_data => {} );
  local $ENV{KARR_FAKE_MODE} = 'assigned';
  my $res = $f->_drain_repo( $repo,
    { command => $agent, max_runtime => 60, mode => 'ticket' } );

  is $res->{outcome}, 'idle',  'idle, not an error';
  is $res->{ticket},  undef,   'and no ticket to report';
  ok !path( $repo )->child('runs.log')->exists, 'the agent was never started';
  like path( $repo )->child('.karr.log')->slurp_utf8, qr/TICKET none assignable/,
    'the log says why nothing ran';
};

# ---------------------------------------------------------------------------
# Integration: the run is judged by its own card
# ---------------------------------------------------------------------------