view release on metacpan or  search on metacpan

bin/mcp-fs  view on Meta::CPAN

   $| = 1;

   for (;;) {
      4 == read STDIN, my $buf, 4
         or last;
      my $len = unpack "N", $buf;
      $len == read STDIN, $buf, $len
         or die "short perl frame\n";

      my @result = do {
         (my $source, local @ARGV) = unpack "(w/a*)*", $buf;
         ("+", eval $source)
      };

      @result = ("-", $@)
         if $@;

      print pack "N/a*", pack "(w/a*)*", @result
         or die "stdout: $!\n"
   }
};

t/03_simple.t  view on Meta::CPAN

   my ($server) = @_;
   ++$started;
   $timer = AnyEvent->timer (after => 0.01, cb => sub { $server->close });
}, on_close => sub { ++$closed };
ok $started == 1 && $closed == 1, "mcp_http blocks through startup and returns on close";

eval { mcp_http auth => "none", port => 0, on_start => sub { die "startup failed\n" } };
ok $@ =~ /startup failed/, "startup hook exception closes the server and propagates";

{
   local @ARGV = ("--auto-deny=*,write", "--auto-allow=read_lines,read",
      "--auto-deny=*,*,*");
   my $options = mcp_getoptions ({ name => "auto-test" });
   ok JSON::XS::encode_json ($options->{auto_rules}) eq JSON::XS::encode_json ([
      ["deny", "*,write"], ["allow", "read_lines,read"], ["deny", "*,*,*"],
   ]), "CLI collects repeatable allow/deny rules in original order";

   my $perm = AnyEvent::MCP::Server::Permissions->new (
      rules => [{ decision => "deny", action => "^" }],
   );
   my $timer;

t/15_getoptions.t  view on Meta::CPAN

use AnyEvent::MCP::Server::HTTP ();

Getopt::Long::Configure ("require_order");
my $have_websocket = eval {
   require AnyEvent::WebSocket::Server;
   require AnyEvent::WebSocket::Message;
   1
};

{
   local @ARGV = ("--name", "demo", "--bind", ":31740", "--token", "first",
      "--token", "second", "--stdio", "--custom", "yes", "positional");
   my $custom;
   my $options = mcp_getoptions ({ usage => "usage example\n" }, "custom=s" => \$custom);
   is $options->{name}, "demo", "shared name";
   is $options->{bind}, ":31740", "shared bind";
   is_deeply $options->{tokens}, ["first", "second"], "repeatable ordered tokens";
   ok $options->{stdio}, "shared stdio";
   is $custom, "yes", "Getopt::Long application option";
   is_deeply \@ARGV, ["positional"], "require_order leaves positional arguments";
}

{
   local @ARGV = ("--name", "memory", "--custom-instructions", "Use for lasting memories.");
   my $options = mcp_getoptions;
   is $options->{custom_instructions}, "Use for lasting memories.",
      "common custom-instructions option returns instance purpose";
}

{
   local @ARGV = ("--name", "example");
   my $options = mcp_getoptions ({ path => "/custom/", auth => "none" });
   is $options->{path}, "/custom/", "custom endpoint path is returned for startup";
   is $options->{auth}, "none", "explicit unauthenticated mode passed to startup";
}

{
   local @ARGV = ("--bad-option");
   my $error;
   {
      local *STDERR;
      open STDERR, ">", "/dev/null" or die "open /dev/null: $!";
      eval { mcp_getoptions ({ usage => "custom usage\n" }) };
      $error = $@;
   }
   like $error, qr/custom usage/, "usage shown on invalid options";
}

{
   local @ARGV = ("--name", "example");
   my $options = mcp_getoptions;
   is_deeply $options, { name => "example" }, "no unnecessary option defaults";
}

my $dir = File::Temp::tempdir (CLEANUP => 1);
local $ENV{XDG_CONFIG_HOME} = $dir;
my $config = AnyEvent::MCP::Config->new (file => "$dir/anyevent-mcp/global.ini");

sub command {
   my ($script, @argv) = @_;