MCP/Server/Simple.pm

=head1 NAME

AnyEvent::MCP::Server::Simple - simple function interface for MCP servers

=head1 SYNOPSIS

   use AnyEvent::MCP::Server::Simple;

   mcp_config
      server_info   => {
         name    => "example",
         version => "0",
      },
      instructions => <<'EOF';
         Use echo to return the supplied text.
   EOF

   mcp_tool echo =>
      "Return the supplied text.",
      {
         type       => "object",
         properties => { text => { type => "string" } },
         required   => ["text"],
      },
      sub {
         my ($req, $args) = @_;

         $req->reply ({
            content => [{ type => "text", text => $args->{text} }],
         });
      };

   mcp_start;

=head1 DESCRIPTION

For most MCP servers, registering a few tools and starting a transport is
enough. This module does just that: call C<mcp_tool> to register callbacks,
optionally configure the server with C<mcp_config>, then start it with
C<mcp_start>, C<mcp_stdio> or C<mcp_http>. Registration alone does not start
a server or an event loop.

Human-readable descriptions and instructions are stripped of surrounding
whitespace and common indentation when registered, so indented here-documents
can be used naturally.

C<mcp_start>, C<mcp_stdio> and C<mcp_http> are alternative blocking entry
points for a self-contained server. They run AnyEvent until shutdown; you
do not start another event loop. If your application already owns the server
lifetime or needs several transports, use the object interfaces instead.

Simple uses L<AnyEvent::MCP::Server> and a default Toolset internally; it is
not a second server implementation. Applications needing custom dispatch,
such as a multibroker, can use the Server API directly.

=head1 FUNCTIONS

=over

=item mcp_config %config

Adds server configuration. Repeated calls extend or replace previously declared
values. C<instructions> is treated as human-readable text and normalized.

C<server_info> contains the MCP server metadata, including C<name> and
C<version>. C<instructions> contains guidance for the client.

C<on_request> is a synchronous hook called before dispatch:

   $callback->($server, $req)

For example, an application can refresh database state before each request.
It does not replace dispatch or receive a completion callback. These options
belong to Server; Simple merely collects and passes them on.

C<on_start> is C<$callback->($server)>, called after the transport is ready
and before entering the event loop. It can print application startup
information or install watchers. C<$server> is the underlying server object.
The callback must not block.

=item mcp_tool $name, $description, $input_schema, $callback->($req, $args)

Registers a tool named C<$name> with C<$description> and the JSON Schema
hash reference C<$input_schema>. C<$description> is normalized like
C<instructions>.

C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
and its C<< $req->{args} >> hash reference as C<$args>, for convenience.

Tools complete the request with C<< $req->reply ($result) >>, or use
C<< $req->result ($data) >> and C<< $req->error ($message) >> for convenience.
Request context is available directly in
the hash, for example C<< $req->{tool} >> and C<< $req->{server} >>.

=item mcp_start %config

Starts and runs the usual server. When
C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL> is C<stdio>, uses C<mcp_stdio>.
Otherwise starts HTTP and prints its cookie URL to stdout.

The HTTP defaults are loopback, an automatically assigned port and C</>
as the endpoint path. The same derived token authenticates either the cookie
URL or an C<Authorization: Bearer TOKEN> header at the clean URL returned by
C<< $server->url (0) >>. C<anyevent-mcp token NAME> prints this token.

C<name> selects the C<[server NAME]> configuration section and credential.
It defaults to C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS>, then C<< server_info->{name} >>,
then the program's basename.
Named settings C<host>, C<port>, C<path>, C<url_host> and C<url_scheme>, C<cookie>, C<bearer> and C<users> are
loaded from the global configuration. Collected configuration and arguments
override these settings. Explicit authentication options replace the default authentication.

The global secret is generated automatically when needed; see
L<AnyEvent::MCP/GLOBAL CONFIGURATION>. No configuration is loaded for stdio.
The URL is printed before C<on_start> is called. Output buffering is left
to the application.

=item mcp_stdio %config

Creates and runs a server over stdin/stdout. Arguments override the collected
configuration. Stdout buffering is disabled. On stdin EOF, pending replies
finish and stdout drains before
this function returns. Stream errors close the connection and cancel pending
requests.

=item mcp_http %config

Creates and runs an HTTP server. For example:

   mcp_http
      host => "127.0.0.1",
      port => 31740,
      path => "/mcp/";

Arguments override the collected configuration. Unlike C<mcp_start>, this
function does not supply cookie authentication or print a URL; use
C<on_start> for application-specific startup output.

All three starters return when the server is closed or on C<SIGINT> or
C<SIGTERM>. Signal shutdown closes connections and cancels outstanding
requests. The signal watchers belong to the blocking call.

=back

=cut

package AnyEvent::MCP::Server::Simple;

use common::sense;
use AnyEvent ();
use AnyEvent::MCP ();
use AnyEvent::MCP::Server::Toolset ();
use Exporter ();

our @ISA = qw(Exporter);
our @EXPORT = qw(mcp_config mcp_tool mcp_start mcp_stdio mcp_http);

my %config;
my $toolset = AnyEvent::MCP::Server::Toolset->new;

sub _run;

sub mcp_config {
   my %kv = @_;

   $kv{instructions} = AnyEvent::MCP::_clean_text $kv{instructions}
      if exists $kv{instructions};

   @config{keys %kv} = values %kv;
}

sub mcp_tool {
   $toolset->tool (@_)
}

sub mcp_start {
   require File::Basename;

   my %kv = (%config, @_);
   my $name = $kv{name} || $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS} || ($kv{server_info} && $kv{server_info}{name})
      || File::Basename::basename ($0);

   $kv{name} = $name;
   $kv{server_info} ||= { name => $name, version => "0" };

   return mcp_stdio (%kv)
      if $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio";

   require AnyEvent::MCP::Config;
   my $global = AnyEvent::MCP::Config->global;
   my $settings = $global->{section}{"server $name"} || {};

   %kv = (
      path => "/",
      (map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
         qw(host port path url_host url_scheme cookie bearer users)),
      %kv,
   );

   unless (grep exists $kv{$_}, qw(cookie bearer users)) {
      my $token = $global->credential ("cookie", $name);
      @kv{qw(cookie bearer)} = ($token, $token);
   }

   my $on_start = $kv{on_start};
   mcp_http (%kv, on_start => sub {
      my ($server) = @_;

      print $server->url, "\n";
      $on_start->($server) if $on_start;
   })
}

sub mcp_stdio {
   require AnyEvent::MCP::Server::JSONL;

   binmode STDIN;
   binmode STDOUT;
   my $selected = select STDOUT;
   $| = 1;
   select $selected;

   my $server = AnyEvent::MCP::Server::JSONL->new (toolsets => [$toolset], %config, @_);
   $server->accept (\*STDIN, \*STDOUT);
   _run $server
}

sub mcp_http {
   require AnyEvent::MCP::Server::HTTP;

   my $server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], %config, @_);
   $server->listen;
   _run $server
}

sub _run {
   my ($server) = @_;

   my $cv = AnyEvent->condvar;
   my $stopped;
   my $stop = sub { $cv->send unless $stopped++ };
   my $on_close = $server->{on_close};
   $server->{on_close} = sub {
      $on_close->(@_) if $on_close;
      $stop->();
   };

   if ($server->isa ("AnyEvent::MCP::Server::JSONL")) {
      my $on_connection_close = $server->{on_connection_close};
      $server->{on_connection_close} = sub {
         $on_connection_close->(@_) if $on_connection_close;
         $stop->();
      };
   }

   my @signals = map {
      AnyEvent->signal (signal => $_, cb => sub { $server->close })
   } qw(INT TERM);

   my $ok = eval {
      $server->event (start =>);
      $cv->recv;
      1
   };
   my $error = $@;
   $server->close;
   die $error unless $ok;
   return
}

1
Revision:	1.2
Committed:	Fri Oct 9 09:36:49 2026 UTC (4 weeks, 2 days ago) by root
Branch:	MAIN
Changes since 1.1:	+12 -10 lines
Log Message:	* empty log message *
#	User	Rev	Content
1	root	1.1	=head1 NAME
2
3			AnyEvent::MCP::Server::Simple - simple function interface for MCP servers
4
5			=head1 SYNOPSIS
6
7			use AnyEvent::MCP::Server::Simple;
8
9			mcp_config
10			server_info => {
11			name => "example",
12			version => "0",
13			},
14			instructions => <<'EOF';
15			Use echo to return the supplied text.
16			EOF
17
18			mcp_tool echo =>
19			"Return the supplied text.",
20			{
21			type => "object",
22			properties => { text => { type => "string" } },
23			required => ["text"],
24			},
25			sub {
26			my ($req, $args) = @_;
27
28			$req->reply ({
29			content => [{ type => "text", text => $args->{text} }],
30			});
31			};
32
33			mcp_start;
34
35			=head1 DESCRIPTION
36
37	root	1.2	For most MCP servers, registering a few tools and starting a transport is
38			enough. This module does just that: call C<mcp_tool> to register callbacks,
39			optionally configure the server with C<mcp_config>, then start it with
40			C<mcp_start>, C<mcp_stdio> or C<mcp_http>. Registration alone does not start
41			a server or an event loop.
42	root	1.1
43			Human-readable descriptions and instructions are stripped of surrounding
44			whitespace and common indentation when registered, so indented here-documents
45			can be used naturally.
46
47			C<mcp_start>, C<mcp_stdio> and C<mcp_http> are alternative blocking entry
48	root	1.2	points for a self-contained server. They run AnyEvent until shutdown; you
49			do not start another event loop. If your application already owns the server
50			lifetime or needs several transports, use the object interfaces instead.
51
52			Simple uses L<AnyEvent::MCP::Server> and a default Toolset internally; it is
53			not a second server implementation. Applications needing custom dispatch,
54			such as a multibroker, can use the Server API directly.
55	root	1.1
56			=head1 FUNCTIONS
57
58			=over
59
60			=item mcp_config %config
61
62			Adds server configuration. Repeated calls extend or replace previously declared
63			values. C<instructions> is treated as human-readable text and normalized.
64
65			C<server_info> contains the MCP server metadata, including C<name> and
66			C<version>. C<instructions> contains guidance for the client.
67
68			C<on_request> is a synchronous hook called before dispatch:
69
70			$callback->($server, $req)
71
72			For example, an application can refresh database state before each request.
73			It does not replace dispatch or receive a completion callback. These options
74			belong to Server; Simple merely collects and passes them on.
75
76			C<on_start> is C<$callback->($server)>, called after the transport is ready
77			and before entering the event loop. It can print application startup
78			information or install watchers. C<$server> is the underlying server object.
79			The callback must not block.
80
81			=item mcp_tool $name, $description, $input_schema, $callback->($req, $args)
82
83			Registers a tool named C<$name> with C<$description> and the JSON Schema
84			hash reference C<$input_schema>. C<$description> is normalized like
85			C<instructions>.
86
87			C<$callback> receives an L<AnyEvent::MCP::Server::Request> object C<$req>
88			and its C<< $req->{args} >> hash reference as C<$args>, for convenience.
89
90			Tools complete the request with C<< $req->reply ($result) >>, or use
91			C<< $req->result ($data) >> and C<< $req->error ($message) >> for convenience.
92			Request context is available directly in
93			the hash, for example C<< $req->{tool} >> and C<< $req->{server} >>.
94
95			=item mcp_start %config
96
97			Starts and runs the usual server. When
98			C<PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL> is C<stdio>, uses C<mcp_stdio>.
99			Otherwise starts HTTP and prints its cookie URL to stdout.
100
101			The HTTP defaults are loopback, an automatically assigned port and C</>
102			as the endpoint path. The same derived token authenticates either the cookie
103			URL or an C<Authorization: Bearer TOKEN> header at the clean URL returned by
104			C<< $server->url (0) >>. C<anyevent-mcp token NAME> prints this token.
105
106			C<name> selects the C<[server NAME]> configuration section and credential.
107			It defaults to C<PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS>, then C<< server_info->{name} >>,
108			then the program's basename.
109			Named settings C<host>, C<port>, C<path>, C<url_host> and C<url_scheme>, C<cookie>, C<bearer> and C<users> are
110			loaded from the global configuration. Collected configuration and arguments
111			override these settings. Explicit authentication options replace the default authentication.
112
113			The global secret is generated automatically when needed; see
114			L<AnyEvent::MCP/GLOBAL CONFIGURATION>. No configuration is loaded for stdio.
115			The URL is printed before C<on_start> is called. Output buffering is left
116			to the application.
117
118			=item mcp_stdio %config
119
120			Creates and runs a server over stdin/stdout. Arguments override the collected
121			configuration. Stdout buffering is disabled. On stdin EOF, pending replies
122			finish and stdout drains before
123			this function returns. Stream errors close the connection and cancel pending
124			requests.
125
126			=item mcp_http %config
127
128			Creates and runs an HTTP server. For example:
129
130			mcp_http
131			host => "127.0.0.1",
132			port => 31740,
133			path => "/mcp/";
134
135			Arguments override the collected configuration. Unlike C<mcp_start>, this
136			function does not supply cookie authentication or print a URL; use
137			C<on_start> for application-specific startup output.
138
139			All three starters return when the server is closed or on C<SIGINT> or
140			C<SIGTERM>. Signal shutdown closes connections and cancels outstanding
141			requests. The signal watchers belong to the blocking call.
142
143			=back
144
145			=cut
146
147			package AnyEvent::MCP::Server::Simple;
148
149			use common::sense;
150			use AnyEvent ();
151			use AnyEvent::MCP ();
152			use AnyEvent::MCP::Server::Toolset ();
153			use Exporter ();
154
155			our @ISA = qw(Exporter);
156			our @EXPORT = qw(mcp_config mcp_tool mcp_start mcp_stdio mcp_http);
157
158			my %config;
159			my $toolset = AnyEvent::MCP::Server::Toolset->new;
160
161			sub _run;
162
163			sub mcp_config {
164			my %kv = @_;
165
166			$kv{instructions} = AnyEvent::MCP::_clean_text $kv{instructions}
167			if exists $kv{instructions};
168
169			@config{keys %kv} = values %kv;
170			}
171
172			sub mcp_tool {
173			$toolset->tool (@_)
174			}
175
176			sub mcp_start {
177			require File::Basename;
178
179			my %kv = (%config, @_);
180			my $name = $kv{name} \|\| $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_ALIAS} \|\| ($kv{server_info} && $kv{server_info}{name})
181			\|\| File::Basename::basename ($0);
182
183			$kv{name} = $name;
184			$kv{server_info} \|\|= { name => $name, version => "0" };
185
186			return mcp_stdio (%kv)
187			if $ENV{PERL_ANYEVENT_MCP_MULTIBROKER_PROTOCOL} eq "stdio";
188
189			require AnyEvent::MCP::Config;
190			my $global = AnyEvent::MCP::Config->global;
191			my $settings = $global->{section}{"server $name"} \|\| {};
192
193			%kv = (
194			path => "/",
195			(map { exists $settings->{$_} ? ($_ => $settings->{$_}) : () }
196			qw(host port path url_host url_scheme cookie bearer users)),
197			%kv,
198			);
199
200			unless (grep exists $kv{$_}, qw(cookie bearer users)) {
201			my $token = $global->credential ("cookie", $name);
202			@kv{qw(cookie bearer)} = ($token, $token);
203			}
204
205			my $on_start = $kv{on_start};
206			mcp_http (%kv, on_start => sub {
207			my ($server) = @_;
208
209			print $server->url, "\n";
210			$on_start->($server) if $on_start;
211			})
212			}
213
214			sub mcp_stdio {
215			require AnyEvent::MCP::Server::JSONL;
216
217			binmode STDIN;
218			binmode STDOUT;
219			my $selected = select STDOUT;
220			$\| = 1;
221			select $selected;
222
223			my $server = AnyEvent::MCP::Server::JSONL->new (toolsets => [$toolset], %config, @_);
224			$server->accept (\STDIN, \STDOUT);
225			_run $server
226			}
227
228			sub mcp_http {
229			require AnyEvent::MCP::Server::HTTP;
230
231			my $server = AnyEvent::MCP::Server::HTTP->new (toolsets => [$toolset], %config, @_);
232			$server->listen;
233			_run $server
234			}
235
236			sub _run {
237			my ($server) = @_;
238
239			my $cv = AnyEvent->condvar;
240			my $stopped;
241			my $stop = sub { $cv->send unless $stopped++ };
242			my $on_close = $server->{on_close};
243			$server->{on_close} = sub {
244			$on_close->(@_) if $on_close;
245			$stop->();
246			};
247
248			if ($server->isa ("AnyEvent::MCP::Server::JSONL")) {
249			my $on_connection_close = $server->{on_connection_close};
250			$server->{on_connection_close} = sub {
251			$on_connection_close->(@_) if $on_connection_close;
252			$stop->();
253			};
254			}
255
256			my @signals = map {
257			AnyEvent->signal (signal => $_, cb => sub { $server->close })
258			} qw(INT TERM);
259
260			my $ok = eval {
261			$server->event (start =>);
262			$cv->recv;
263			1
264			};
265			my $error = $@;
266			$server->close;
267			die $error unless $ok;
268			return
269			}
270
271			1