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

This module is the function-based interface for implementing ordinary MCP
servers. Declarations are collected first; C<mcp_start>, C<mcp_stdio> or C<mcp_http> then
creates the underlying L<AnyEvent::MCP::Server> object.

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; the
application does not start another event loop. Use the object interfaces
for embedded servers, several transports or explicit lifetime management.

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