view release on metacpan or  search on metacpan

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

  return time < $until ? 1 : 0;
}

sub _set_cooldown {
  my ( $self, $repo, $karr ) = @_;
  return if $self->dry_run;
  my $base    = $karr->{cooldown_base} // 1;    # minutes at level 0
  my $cap     = $karr->{cooldown_max}  // 64;   # minutes ceiling
  my $level   = $self->_state_get( $repo, 'cooldown_level' ) // 0;
  my $minutes = $base * ( 2 ** $level );
  $minutes = $cap if $minutes > $cap;
  $self->_state_set( $repo,
    cooldown_level => $level + 1,
    cooldown_until => time + $minutes * 60,
  );
  $self->_say_verbose( "cooldown $repo — ${minutes}m (level " . ( $level + 1 ) . ")" );
  return $minutes;
}

sub _clear_cooldown {
  my ( $self, $repo ) = @_;
  return if $self->dry_run;
  my $level = $self->_state_get( $repo, 'cooldown_level' ) // 0;
  return unless $level;
  $self->_state_set( $repo, cooldown_level => 0, cooldown_until => 0 );
}

# ---------------------------------------------------------------------------
# Command execution
# ---------------------------------------------------------------------------

sub _run_command {
  my ( $self, $repo, $karr, $cmd ) = @_;
  my $command      = $cmd // $karr->{command};
  my $max_runtime  = $karr->{max_runtime} // 1800;
  my $stream_terms = $self->_stream_to_terminal;

  # Environment for the child (and all karr calls it spawns). Set before the
  # substitution so a command template — including the synthesized claude
  # command — can reference $PROMPT, $KARR_REPO, etc.
  local $ENV{KARR_REPO} = "$repo";
  local $ENV{KARR_ROLE} = 'agent';
  local $ENV{PROMPT}    = $self->_prompt_for($karr);

  # Env-var substitution in command string
  $command =~ s/\$\{(\w+)\}/$ENV{$1} \/\/ ''/ge;
  $command =~ s/\$(\w+)/$ENV{$1} \/\/ ''/ge;

  $self->_append_log( $repo, "START command=$command" );
  $self->_say_verbose("exec in $repo: $command");

  if ( $self->dry_run ) {
    $self->_append_log( $repo, "DRY-RUN (skipped)" );
    return ( 0, '' );
  }

  my $log_file = $repo->child('.karr.log');

  # Native pipe: the child writes stdout+stderr, the parent reads. The parent
  # is the tee — it fans each chunk to the persistent log, the terminal (when
  # streaming), and an in-memory buffer for error scanning. No external tee
  # process to race, and the run's output is captured directly (no re-slurping
  # the log via byte offsets).
  pipe( my $reader, my $writer ) or croak "pipe failed: $!";

  my $pid = fork;
  croak "fork failed: $!" unless defined $pid;

  if ( $pid == 0 ) {
    # child
    close $reader;
    chdir "$repo" or die "chdir $repo: $!";
    open( STDOUT, '>&', $writer ) or die "dup stdout: $!";
    open( STDERR, '>&STDOUT' )    or die "dup stderr: $!";
    exec( '/bin/sh', '-c', $command ) or die "exec: $!";
  }

  # parent
  close $writer;
  open( my $log_fh, '>>', "$log_file" ) or croak "open log: $!";
  $log_fh->autoflush(1);

  my $started   = time;
  my $output    = '';
  my $timed_out = 0;
  my $sel       = IO::Select->new($reader);

  while (1) {
    my $wait;
    if ( $max_runtime > 0 ) {
      $wait = $max_runtime - ( time - $started );
      if ( $wait <= 0 ) { $timed_out = 1; last }
    }
    # undef $wait => block indefinitely (max_runtime: 0 disables the timeout).
    my @ready = $sel->can_read($wait);
    unless (@ready) {
      # Spurious wakeup (signal) or deadline. Only the deadline ends the loop.
      next unless $max_runtime > 0;
      if ( time - $started >= $max_runtime ) { $timed_out = 1; last }
      next;
    }
    my $chunk;
    my $n = sysread( $reader, $chunk, 65536 );
    last if !defined $n;   # read error
    last if $n == 0;       # EOF — the command closed its output
    print {$log_fh} $chunk;
    print $chunk if $stream_terms;
    $output .= $chunk;
  }

  my $exit_code;
  if ($timed_out) {
    my $elapsed = time - $started;
    $self->_append_log( $repo, "TIMEOUT after ${elapsed}s — sending SIGTERM to $pid" );
    kill 'TERM', $pid;
    sleep 2;
    kill 'KILL', $pid;
    waitpid( $pid, 0 );
    $exit_code = -1;
  } else {
    waitpid( $pid, 0 );