view release on metacpan or  search on metacpan

t/31-foundation-drain.t  view on Meta::CPAN

      $t->claimed_by('fake-agent');
      $store->save_task($t);
    }
    # already claimed/in-progress -> do nothing -> no board change -> stall
  }
}
elsif ( $mode eq 'error' ) {
  print "Error: rate limit exceeded, retry later\n";
  exit 0;
}
PERL
  return qq{$^X -I"$lib" "$script"};
}

# ---------------------------------------------------------------------------
# Unit: actionability
# ---------------------------------------------------------------------------

subtest '_is_actionable' => sub {
  my $f = App::karr::Foundation->new;
  ok   $f->_is_actionable({ status => 'todo' }),                 'todo actionable';
  ok   $f->_is_actionable({ status => 'in-progress' }),          'in-progress actionable';
  ok   $f->_is_actionable({ status => 'backlog' }),              'backlog actionable';
  ok ! $f->_is_actionable({ status => 'done' }),                 'done not actionable';
  ok ! $f->_is_actionable({ status => 'archived' }),             'archived not actionable';
  ok ! $f->_is_actionable({ status => 'todo', blocked => 1 }),   'blocked not actionable';
  ok ! $f->_is_actionable(undef),                                'undef not actionable';
};

subtest '_has_actionable_tasks' => sub {
  my $repo = make_git_repo();
  seed_board( $repo, { status => 'done' }, { status => 'todo', blocked => 'x' } );
  my $f = App::karr::Foundation->new;
  ok ! $f->_has_actionable_tasks( $repo ), 'done + blocked => none actionable';
  seed_board( $repo, { status => 'todo' } );
  ok $f->_has_actionable_tasks( $repo ), 'a todo makes it actionable';
};

# ---------------------------------------------------------------------------
# Unit: common-error detection
# ---------------------------------------------------------------------------

subtest 'error patterns' => sub {
  my $f = App::karr::Foundation->new;
  my $pat = $f->_error_patterns({});
  is $f->_match_error( "blah RATE LIMIT hit", $pat ), 'rate limit', 'case-insensitive default';
  is $f->_match_error( "all good\n", $pat ), undef, 'clean text => undef';
  is $f->_match_error( '', $pat ), undef, 'empty => undef';

  my $cp = $f->_error_patterns({ error_patterns => ['kaboom'] });
  is $f->_match_error( "something kaboom", $cp ), 'kaboom', 'custom pattern matches';
};

# ---------------------------------------------------------------------------
# Unit: stuck-task detection
# ---------------------------------------------------------------------------

subtest '_stuck_tasks' => sub {
  my $f = App::karr::Foundation->new;
  my $before = {
    1 => { status => 'in-progress', claimed_by => 'a', updated => 'T1' },
    2 => { status => 'todo',        claimed_by => undef, updated => 'T1' },
    3 => { status => 'in-progress', claimed_by => 'a', updated => 'T1' },
  };
  my $after = {
    1 => { status => 'in-progress', claimed_by => 'a', updated => 'T1' },  # unchanged -> stuck
    2 => { status => 'todo',        claimed_by => undef, updated => 'T1' }, # not claimed -> ignore
    3 => { status => 'done',        claimed_by => 'a', updated => 'T2' },  # advanced -> not stuck
  };
  is_deeply [ $f->_stuck_tasks( $before, $after ) ], [1], 'only the unchanged claimed task is stuck';

  # blocked task is never stuck
  my $b2 = { 1 => { status => 'in-progress', claimed_by => 'a', updated => 'T1' } };
  my $a2 = { 1 => { status => 'in-progress', claimed_by => 'a', updated => 'T1', blocked => 1 } };
  is_deeply [ $f->_stuck_tasks( $b2, $a2 ) ], [], 'blocked task drops out';
};

# ---------------------------------------------------------------------------
# Unit: attempts counter
# ---------------------------------------------------------------------------

subtest 'attempts counter' => sub {
  my $repo = tempdir( CLEANUP => 1 );
  my $f = App::karr::Foundation->new;
  is $f->_bump_attempts( $repo, 7 ), 1, 'first bump => 1';
  is $f->_bump_attempts( $repo, 7 ), 2, 'second bump => 2';
  is $f->_state_get( $repo, 'attempts' )->{7}, 2, 'persisted in state';
  $f->_reset_attempts( $repo, 7 );
  ok ! exists $f->_state_get( $repo, 'attempts' )->{7}, 'reset removes key';
};

# ---------------------------------------------------------------------------
# Unit: exponential cooldown
# ---------------------------------------------------------------------------

subtest 'exponential cooldown' => sub {
  my $repo = tempdir( CLEANUP => 1 );
  my $f = App::karr::Foundation->new;
  my $karr = { cooldown_base => 1, cooldown_max => 4 };
  is $f->_set_cooldown( $repo, $karr ), 1, 'level0 => 1m';
  ok $f->_cooldown_active( $repo ), 'active right after set';
  is $f->_set_cooldown( $repo, $karr ), 2, 'level1 => 2m';
  is $f->_set_cooldown( $repo, $karr ), 4, 'level2 => 4m';
  is $f->_set_cooldown( $repo, $karr ), 4, 'level3 capped at 4m';
  $f->_clear_cooldown( $repo );
  is $f->_state_get( $repo, 'cooldown_level' ), 0, 'cleared level back to 0';
  $f->_state_set( $repo, cooldown_until => time - 1 );
  ok ! $f->_cooldown_active( $repo ), 'past timestamp => inactive';
};

# ---------------------------------------------------------------------------
# Unit: auto-block via BoardStore
# ---------------------------------------------------------------------------

subtest '_autoblock_task' => sub {
  my $repo = make_git_repo();
  seed_board( $repo, { status => 'in-progress', claimed_by => 'a' } );
  my $f = App::karr::Foundation->new;
  ok $f->_autoblock_task( $repo, 1, 'auto: nope' ), 'autoblock returns true';
  my $t = task_by_id( $repo, 1 );
  ok $t->has_blocked, 'task is blocked';
  is $t->blocked, 'auto: nope', 'block reason stored';
};

# ---------------------------------------------------------------------------
# Integration: drain to completion on progress
# ---------------------------------------------------------------------------

subtest 'drain completes when agent makes progress' => sub {
  my $repo  = make_git_repo();
  seed_board( $repo, { status => 'todo' }, { status => 'todo' }, { status => 'todo' } );
  my $agent = write_fake_agent( $repo );

  my $f = App::karr::Foundation->new;