File Coverage

blib/lib/MCP/Run.pm

Criterion	Covered	Total	%
statement	66	80	82.5
branch	19	22	86.3
condition	18	33	54.5
subroutine	7	9	77.7
pod	4	4	100.0
total	114	148	77.0

package MCP::Run;
our $VERSION = '0.004';
use Mojo::Base 'MCP::Server', -signatures;

# ABSTRACT: MCP server with a command execution tool


has allowed_commands  => sub { undef };


has validator => sub { undef };


has working_directory => sub { undef };


has timeout           => 30;


has tool_name         => 'run';


has tool_description  => sub {
  my $self = shift;
  my $base = 'Execute a command and return stdout, stderr, and exit code';
  if ($self->compress) {
    $base .= '. Output is compressed for token efficiency - set compress:false in arguments if you need full detail';
  }
  return $base;
};


has compress          => 0;


sub new ($class, %args) {
  my $self = $class->SUPER::new(%args);
  $self->_register_run_tool;
  return $self;
}

sub _register_run_tool ($self) {
  my $server = $self;
  $self->tool(
    name         => $self->tool_name,
    description  => $self->tool_description,
    input_schema => {
      type       => 'object',
      properties => {
        command           => { type => 'string',  description => 'The command to execute' },
        working_directory => { type => 'string',  description => 'Working directory for the command' },
        timeout           => { type => 'integer', description => 'Timeout in seconds' },
        compress          => { type => 'boolean', description => 'Compress output for LLM efficiency' },
      },
      required => ['command'],
    },
    code => sub ($tool, $args) { $server->_handle_run($tool, $args) },
  );
}

sub _handle_run ($self, $tool, $args) {
  my $command = $args->{command};

  if (my $allowed = $self->allowed_commands) {
    my ($first_word) = $command =~ /^\s*(\S+)/;
    unless ($first_word && grep { $_ eq $first_word } @$allowed) {
      return $tool->text_result("Command not allowed: $first_word", 1);
    }
  }

  if (my $validator = $self->validator) {
    my $vresult = $validator->($command, $args->{working_directory});
    unless (defined($vresult) && !ref($vresult) && $vresult eq '1') {
      my $reason = defined($vresult) && length($vresult) ? $vresult : 'denied';
      return $tool->text_result("Command $reason", 1);
    }
  }

  my $wd      = $args->{working_directory} // $self->working_directory;
  my $timeout = $args->{timeout}           // $self->timeout;
  my $compress = $args->{compress}         // $self->compress;

  my $result = $self->execute($command, $wd, $timeout);
  return $self->format_result($tool, $result, $compress);
}

sub run_stdio ($class_or_self, %args) {
  my $self = ref $class_or_self ? $class_or_self : $class_or_self->new(%args);
  $self->to_stdio;
  return $self;
}


sub execute ($self, $command, $working_directory, $timeout) {
  die "execute() must be implemented by a subclass";
}


sub format_result ($self, $tool, $result, $compress = undef) {
  my $exit_code = $result->{exit_code} // -1;
  my $stdout    = $result->{stdout}    // '';
  my $stderr    = $result->{stderr}    // '';
  my $error     = $result->{error};

  $compress //= $self->compress;

  if ($compress) {
    (my $compressor) = $self->_get_compressor;
    ($stdout, $stderr) = $compressor->compress('', $stdout, $stderr);
  }

  my $text = "Exit code: $exit_code\n";
  $text .= "\n=== STDOUT ===\n$stdout\n" if length $stdout;
  $text .= "\n=== STDERR ===\n$stderr\n" if length $stderr;
  $text .= "\n=== ERROR ===\n$error\n"   if defined $error;

  my $is_error = $exit_code != 0 ? 1 : 0;
  return $tool->text_result($text, $is_error);
}

my $_compressor;

sub _get_compressor ($self) {
  $_compressor //= MCP::Run::Compress->new;
  return $_compressor;
}



1;

__END__