view release on metacpan or  search on metacpan

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

use common::sense;
use Test::More;
use File::Temp ();
use IPC::Open3 ();
use Symbol ();
use Getopt::Long ();
use AnyEvent::MCP::Config ();
use AnyEvent::MCP::Server::Simple;
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) = @_;
   my $err = Symbol::gensym;
   my $pid = IPC::Open3::open3 (my $in, my $out, $err,
      $^X, "-Ilib", "-MAnyEvent::MCP::Server::Simple",
      "-e", $script,
      "--", @argv);
   close $in;
   local $/;
   my $stdout = <$out>;
   my $stderr = <$err>;
   waitpid $pid, 0;
   ($? >> 8, $stdout // "", $stderr // "")
}

my $script = 'mcp_getoptions ({ usage => "usage in subprocess\n", path => "/custom/" });';
my ($status, $out, $err) = command ($script, "--name", "demo", "--bind", ":31740",
   "--token", "first", "--token", "second", "--print-url");
is $status, 0, "shared print-url exits without starting a listener";
is $out, "http://127.0.0.1:31740/first/custom/\n", "print-url uses first CLI token and effective URL";
is $err, "", "print-url has no diagnostics";

($status, $out) = command ($script, "--name", "demo", "--help");
is $status, 0, "standard --help succeeds";
like $out, qr/\Ausage in subprocess\n\nCommon options:\n/,
   "shared help includes usage and common option heading";
like $out, qr/--name NAME\s+Select named configuration/,
   "common --name option documented";
like $out, qr/--token TOKEN\s+Set an accepted token/,
   "common repeatable token option documented";

unlike $out, qr/--listen/, "common parser does not advertise --listen";
($status, $out, $err) = command ($script, "--listen");
ok $status && $err =~ /Unknown option: listen/, "common parser rejects --listen";

my $rich = 'my $extra; mcp_getoptions ({'
   . 'usage => "Usage: fixture [OPTION]...\\n", '
   . 'description => "A test server.", '
   . 'option_heading => "Fixture options:", '
   . 'options => [["--extra VALUE", "A configurable value"]], '
   . 'examples => "  fixture --extra yes"}, '
   . '"extra=s" => \\$extra);';
($status, $out, $err) = command ($rich, "--help");
ok !$status && !$err && $out =~ /Fixture options:.*--extra VALUE.*A configurable value/s
   && $out =~ /Examples:\n  fixture --extra yes/, "caller option descriptions and examples appear";

($status, $out, $err) = command ($script, "--name", "demo", "--bind", ":0", "--print-url");
ok $status && $err =~ /port is not known/, "ephemeral port cannot be printed offline";

open my $fh, ">>", "$dir/anyevent-mcp/global.ini" or die $!;
print {$fh} "\n[instance named]\npath = /named/\n";
close $fh or die $!;