view release on metacpan or  search on metacpan

lib/App/Raider/FileTools.pm  view on Meta::CPAN

package App::Raider::FileTools;
our $VERSION = '0.003';
# ABSTRACT: MCP::Server factory with local filesystem tools (list/read/write/edit)

use strict;
use warnings;
use Path::Tiny;
use MCP::Server;

use Exporter 'import';
our @EXPORT_OK = qw( build_file_tools_server );


sub build_file_tools_server {
  my %args = @_;
  my $root = defined $args{root} ? path($args{root})->absolute : undef;

  my $resolve = sub {
    my ($path) = @_;
    my $p = path($path);
    if ($root) {
      $p = $p->is_absolute ? $p : $root->child($path);
      $p = $p->absolute;
      die "Path escapes root: $p\n" unless $root->subsumes($p);
    }
    return $p;
  };

  my $server = MCP::Server->new(name => 'app-raider-files', version => '1.0');

  $server->tool(
    name         => 'list_files',
    description  => 'List entries in a directory. Directories are suffixed with "/".',
    input_schema => {
      type       => 'object',
      properties => { path => { type => 'string', description => 'Directory path' } },
      required   => ['path'],
    },
    code => sub {
      my ($tool, $in) = @_;
      my $p = eval { $resolve->($in->{path}) };
      return $tool->text_result("Error: $@", 1) if $@;
      return $tool->text_result("Error: not a directory: $p", 1) unless -d $p;
      my @entries = sort map { -d $_ ? $_->basename . '/' : $_->basename } $p->children;
      return $tool->text_result(join("\n", @entries));
    },
  );

  $server->tool(
    name         => 'read_file',
    description  => 'Read the full contents of a text file.',
    input_schema => {
      type       => 'object',
      properties => { path => { type => 'string', description => 'File path' } },
      required   => ['path'],
    },
    code => sub {
      my ($tool, $in) = @_;
      my $p = eval { $resolve->($in->{path}) };
      return $tool->text_result("Error: $@", 1) if $@;
      return $tool->text_result("Error: not a file: $p", 1) unless -f $p;
      my $content = eval { $p->slurp_utf8 };
      return $tool->text_result("Error reading $p: $@", 1) if $@;
      return $tool->text_result($content);
    },
  );

  $server->tool(
    name         => 'write_file',
    description  => 'Write contents to a file. Creates parent directories, overwrites existing files.',
    input_schema => {
      type       => 'object',
      properties => {
        path    => { type => 'string', description => 'File path' },
        content => { type => 'string', description => 'Full file contents' },
      },
      required => ['path', 'content'],
    },
    code => sub {
      my ($tool, $in) = @_;
      my $p = eval { $resolve->($in->{path}) };
      return $tool->text_result("Error: $@", 1) if $@;
      eval {
        $p->parent->mkpath unless -d $p->parent;