Script 'mail_helper' called by obssrc Hello community, here is the log from the commit of package perl-MCP for openSUSE:Factory checked in at 2025-12-20 21:47:07 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/perl-MCP (Old) and /work/SRC/openSUSE:Factory/.perl-MCP.new.1928 (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Package is "perl-MCP" Sat Dec 20 21:47:07 2025 rev:3 rq:1323806 version:0.60.0 Changes: -------- --- /work/SRC/openSUSE:Factory/perl-MCP/perl-MCP.changes 2025-10-07 18:31:35.093612886 +0200 +++ /work/SRC/openSUSE:Factory/.perl-MCP.new.1928/perl-MCP.changes 2025-12-20 21:49:46.399344404 +0100 @@ -1,0 +2,17 @@ +Tue Dec 9 05:35:26 UTC 2025 - Tina Müller <[email protected]> + +- updated to 0.60.0 (0.06) + see /usr/share/doc/packages/perl-MCP/Changes + + 0.06 2025-12-05 + - Protocol version is now 2025-11-25. + - Added support for resources. + - Added support for audio and resource results. + - Added support for sessions specific prompt, resource, and tool lists. + - Added MCP::Resource class. + - Added read_resource and list_resources methods to MCP::Client. + - Added resource method to MCP::Server. + - Added audio_result and resource_link_result methods to MCP::Tool. + - Added prompts, resources, and tools events to MCP::Server. + +------------------------------------------------------------------- Old: ---- MCP-0.05.tar.gz New: ---- MCP-0.06.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ perl-MCP.spec ++++++ --- /var/tmp/diff_new_pack.pzC3BO/_old 2025-12-20 21:49:48.691439295 +0100 +++ /var/tmp/diff_new_pack.pzC3BO/_new 2025-12-20 21:49:48.727440785 +0100 @@ -18,10 +18,10 @@ %define cpan_name MCP Name: perl-MCP -Version: 0.50.0 +Version: 0.60.0 Release: 0 -# 0.05 -> normalize -> 0.50.0 -%define cpan_version 0.05 +# 0.06 -> normalize -> 0.60.0 +%define cpan_version 0.06 License: MIT Summary: Connect Perl with AI using MCP (Model Context Protocol) URL: https://metacpan.org/release/%{cpan_name} @@ -42,6 +42,7 @@ Provides: perl(MCP::Client) Provides: perl(MCP::Constants) Provides: perl(MCP::Prompt) +Provides: perl(MCP::Resource) Provides: perl(MCP::Server) Provides: perl(MCP::Server::Transport) Provides: perl(MCP::Server::Transport::HTTP) ++++++ MCP-0.05.tar.gz -> MCP-0.06.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/Changes new/MCP-0.06/Changes --- old/MCP-0.05/Changes 2025-08-28 15:15:26.976650928 +0200 +++ new/MCP-0.06/Changes 2025-12-05 12:56:59.000000000 +0100 @@ -1,8 +1,19 @@ +0.06 2025-12-05 + - Protocol version is now 2025-11-25. + - Added support for resources. + - Added support for audio and resource results. + - Added support for sessions specific prompt, resource, and tool lists. + - Added MCP::Resource class. + - Added read_resource and list_resources methods to MCP::Client. + - Added resource method to MCP::Server. + - Added audio_result and resource_link_result methods to MCP::Tool. + - Added prompts, resources, and tools events to MCP::Server. + 0.05 2025-08-28 - - Added supprot for prompts. + - Added support for prompts. - Added MCP::Prompt class. - - Added get_prompt and list_pronmpts methods to MCP::Client. + - Added get_prompt and list_prompts methods to MCP::Client. - Added prompt method to MCP::Server. 0.04 2025-08-04 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/MANIFEST new/MCP-0.06/MANIFEST --- old/MCP-0.05/MANIFEST 2025-08-28 16:07:39.780347064 +0200 +++ new/MCP-0.06/MANIFEST 2025-12-08 15:14:34.000000000 +0100 @@ -6,6 +6,7 @@ lib/MCP/Client.pm lib/MCP/Constants.pm lib/MCP/Prompt.pm +lib/MCP/Resource.pm lib/MCP/Server.pm lib/MCP/Server/Transport.pm lib/MCP/Server/Transport/HTTP.pm @@ -15,6 +16,7 @@ Makefile.PL MANIFEST This list of files README.md +t/apps/empty.wav t/apps/lite_app.pl t/apps/mojolicious.png t/apps/stdio.pl @@ -22,6 +24,7 @@ t/lite_app.t t/pod.t t/pod_coverage.t +t/session_specific_app.t t/stdio.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/META.json new/MCP-0.06/META.json --- old/MCP-0.05/META.json 2025-08-28 16:07:39.756648793 +0200 +++ new/MCP-0.06/META.json 2025-12-08 15:14:34.000000000 +0100 @@ -4,7 +4,7 @@ "Sebastian Riedel <[email protected]>" ], "dynamic_config" : 0, - "generated_by" : "ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010", + "generated_by" : "ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010", "license" : [ "mit" ], @@ -61,6 +61,6 @@ "web" : "https://web.libera.chat/#mojo"; } }, - "version" : "0.05", + "version" : "0.06", "x_serialization_backend" : "JSON::PP version 4.16" } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/META.yml new/MCP-0.06/META.yml --- old/MCP-0.05/META.yml 2025-08-28 16:07:39.642666757 +0200 +++ new/MCP-0.06/META.yml 2025-12-08 15:14:34.000000000 +0100 @@ -7,7 +7,7 @@ configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 0 -generated_by: 'ExtUtils::MakeMaker version 7.70, CPAN::Meta::Converter version 2.150010' +generated_by: 'ExtUtils::MakeMaker version 7.76, CPAN::Meta::Converter version 2.150010' license: mit meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html @@ -33,5 +33,5 @@ homepage: https://mojolicious.org license: http://www.opensource.org/licenses/mit repository: https://github.com/mojolicious/mojo-mcp.git -version: '0.05' -x_serialization_backend: 'CPAN::Meta::YAML version 0.018' +version: '0.06' +x_serialization_backend: 'CPAN::Meta::YAML version 0.020' diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/README.md new/MCP-0.06/README.md --- old/MCP-0.05/README.md 2025-08-28 15:17:13.050503901 +0200 +++ new/MCP-0.06/README.md 2025-12-04 15:39:51.000000000 +0100 @@ -11,7 +11,7 @@ Please be aware that this module is still in development and will be changing rapidly. Additionally the MCP specification is getting regular updates which we will implement. Breaking changes are very likely. - * Tool calling and prompts + * Tool calling, prompts and resources * Streamable HTTP and Stdio transports * Scalable with pre-forking web server and async tools using promises * HTTP client for testing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP/Client.pm new/MCP-0.06/lib/MCP/Client.pm --- old/MCP-0.05/lib/MCP/Client.pm 2025-08-28 15:14:03.344105486 +0200 +++ new/MCP-0.06/lib/MCP/Client.pm 2025-12-04 15:39:51.000000000 +0100 @@ -46,9 +46,15 @@ return $result; } -sub list_prompts ($self) { _result($self->send_request($self->build_request('prompts/list'))) } -sub list_tools ($self) { _result($self->send_request($self->build_request('tools/list'))) } -sub ping ($self) { _result($self->send_request($self->build_request('ping'))) } +sub list_prompts ($self) { _result($self->send_request($self->build_request('prompts/list'))) } +sub list_resources ($self) { _result($self->send_request($self->build_request('resources/list'))) } +sub list_tools ($self) { _result($self->send_request($self->build_request('tools/list'))) } +sub ping ($self) { _result($self->send_request($self->build_request('ping'))) } + +sub read_resource ($self, $uri) { + my $request = $self->build_request('resources/read', {uri => $uri}); + return _result($self->send_request($request)); +} sub send_request ($self, $request) { my $headers = {Accept => 'application/json, text/event-stream', 'Content-Type' => 'application/json'}; @@ -192,6 +198,12 @@ Lists all available prompts on the MCP server. +=head2 list_resources + + my $resources = $client->list_resources; + +Lists all available resources on the MCP server. + =head2 list_tools my $tools = $client->list_tools; @@ -204,6 +216,12 @@ Sends a ping request to the MCP server to check connectivity. +=head2 read_resource + + my $result = $client->read_resource('file:///path/to/resource.txt'); + +Reads a resource from the MCP server with the specified URI, returning the result. + =head2 send_request my $response = $client->send_request($request); diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP/Constants.pm new/MCP-0.06/lib/MCP/Constants.pm --- old/MCP-0.05/lib/MCP/Constants.pm 2025-08-01 16:23:46.411538990 +0200 +++ new/MCP-0.06/lib/MCP/Constants.pm 2025-12-04 16:10:03.000000000 +0100 @@ -2,14 +2,15 @@ use Mojo::Base 'Exporter'; use constant { - INVALID_PARAMS => -32602, - INVALID_REQUEST => -32600, - METHOD_NOT_FOUND => -32601, - PARSE_ERROR => -32700, - PROTOCOL_VERSION => '2025-06-18' + INVALID_PARAMS => -32602, + INVALID_REQUEST => -32600, + METHOD_NOT_FOUND => -32601, + PARSE_ERROR => -32700, + PROTOCOL_VERSION => $ENV{MOJO_MCP_VERSION} || '2025-11-25', + RESOURCE_NOT_FOUND => -32002 }; -our @EXPORT_OK = qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION); +our @EXPORT_OK = qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); 1; @@ -51,6 +52,10 @@ The version of the Model Context Protocol being used. +=head2 RESOURCE_NOT_FOUND + +The error code for a resource that was not found. + =head1 SEE ALSO L<MCP>, L<https://mojolicious.org>, L<https://modelcontextprotocol.io>. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP/Resource.pm new/MCP-0.06/lib/MCP/Resource.pm --- old/MCP-0.05/lib/MCP/Resource.pm 1970-01-01 01:00:00.000000000 +0100 +++ new/MCP-0.06/lib/MCP/Resource.pm 2025-12-05 14:06:47.000000000 +0100 @@ -0,0 +1,129 @@ +package MCP::Resource; +use Mojo::Base -base, -signatures; + +use Mojo::Util qw(b64_encode); +use Scalar::Util qw(blessed); + +has code => sub { die 'Resource code not implemented' }; +has description => 'Generic MCP resource'; +has mime_type => 'text/plain'; +has name => 'resource'; +has uri => 'file://unknown'; + +sub binary_resource ($self, $data) { + my $result = {contents => [{uri => $self->uri, mimeType => $self->mime_type, blob => b64_encode($data, '')}]}; + return $result; +} + +sub call ($self, $context) { + local $self->{context} = $context; + my $result = $self->code->($self); + return $result->then(sub { $self->_type_check($_[0]) }) if blessed($result) && $result->isa('Mojo::Promise'); + return $self->_type_check($result); +} + +sub context ($self) { $self->{context} || {} } + +sub text_resource ($self, $text) { + my $result = {contents => [{uri => $self->uri, mimeType => $self->mime_type, text => $text}]}; + return $result; +} + +sub _type_check ($self, $result) { + return $result if ref $result eq 'HASH' && exists $result->{contents}; + return $self->text_resource($result); +} + +1; + +=encoding utf8 + +=head1 NAME + +MCP::Resource - Resource container + +=head1 SYNOPSIS + + use MCP::Resource; + + my $resource = MCP::Resource->new; + +=head1 DESCRIPTION + +L<MCP::Resource> is a container for resources. + +=head1 ATTRIBUTES + +L<MCP::Resource> implements the following attributes. + +=head2 code + + my $code = $resource->code; + $resource = $resource->code(sub { ... }); + +Resource code. + +=head2 description + + my $description = $resource->description; + $resource = $resource->description('A brief description of the resource'); + +Description of the resource. + +=head2 mime_type + + my $mime_type = $resource->mime_type; + $resource = $resource->mime_type('text/plain'); + +MIME type of the resource. + +=head2 name + + my $name = $resource->name; + $resource = $resource->name('my_resource'); + +Name of the resource. + +=head2 uri + + my $uri = $resource->uri; + $resource = $resource->uri('file:///path/to/resource.txt'); + +URI of the resource. + +=head1 METHODS + +L<MCP::Resource> inherits all methods from L<Mojo::Base> and implements the following new ones. + +=head2 binary_resource + + my $result = $resource->binary_resource($data); + +Returns a binary resource in the expected format. + +=head2 call + + my $result = $resource->call($context); + +Calls the resource with context, returning a result. The result can be a promise or a direct value. + +=head2 context + + my $context = $resource->context; + +Returns the context in which the resouce is executed. + + # Get controller for requests using the HTTP transport + my $c = $resource->context->{controller}; + +=head2 text_resource + + my $result = $resource->text_resource('Some text'); + +Returns a text resource in the expected format. + +=head1 SEE ALSO + +L<MCP>, L<https://mojolicious.org>, L<https://modelcontextprotocol.io>. + +=cut diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP/Server.pm new/MCP-0.06/lib/MCP/Server.pm --- old/MCP-0.05/lib/MCP/Server.pm 2025-08-28 16:03:20.743712599 +0200 +++ new/MCP-0.06/lib/MCP/Server.pm 2025-12-05 13:03:34.000000000 +0100 @@ -1,18 +1,20 @@ package MCP::Server; -use Mojo::Base -base, -signatures; +use Mojo::Base 'Mojo::EventEmitter', -signatures; use List::Util qw(first); use Mojo::JSON qw(false true); -use MCP::Constants qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION); +use MCP::Constants qw(INVALID_PARAMS INVALID_REQUEST METHOD_NOT_FOUND PARSE_ERROR PROTOCOL_VERSION RESOURCE_NOT_FOUND); use MCP::Prompt; +use MCP::Resource; use MCP::Server::Transport::HTTP; use MCP::Server::Transport::Stdio; use MCP::Tool; use Scalar::Util qw(blessed); -has name => 'PerlServer'; -has prompts => sub { [] }; -has tools => sub { [] }; +has name => 'PerlServer'; +has prompts => sub { [] }; +has resources => sub { [] }; +has tools => sub { [] }; has 'transport'; has version => '1.0.0'; @@ -27,22 +29,29 @@ my $result = $self->_handle_initialize($request->{params} // {}); return _jsonrpc_response($result, $id); } + elsif ($method eq 'tools/list') { + my $result = $self->_handle_tools_list($context); + return _jsonrpc_response($result, $id); + } + elsif ($method eq 'tools/call') { + return $self->_handle_tools_call($request->{params} // {}, $id, $context); + } elsif ($method eq 'ping') { return _jsonrpc_response({}, $id); } elsif ($method eq 'prompts/list') { - my $result = $self->_handle_prompts_list; + my $result = $self->_handle_prompts_list($context); return _jsonrpc_response($result, $id); } elsif ($method eq 'prompts/get') { return $self->_handle_prompts_get($request->{params} // {}, $id, $context); } - elsif ($method eq 'tools/list') { - my $result = $self->_handle_tools_list; + elsif ($method eq 'resources/list') { + my $result = $self->_handle_resources_list($context); return _jsonrpc_response($result, $id); } - elsif ($method eq 'tools/call') { - return $self->_handle_tools_call($request->{params} // {}, $id, $context); + elsif ($method eq 'resources/read') { + return $self->_handle_resources_read($request->{params} // {}, $id, $context); } # Method not found @@ -59,6 +68,12 @@ return $prompt; } +sub resource ($self, %args) { + my $resource = MCP::Resource->new(%args); + push @{$self->resources}, $resource; + return $resource; +} + sub to_action ($self) { $self->transport(my $http = MCP::Server::Transport::HTTP->new(server => $self)); return sub ($c) { $http->handle_request($c) }; @@ -78,14 +93,14 @@ sub _handle_initialize ($self, $params) { return { protocolVersion => PROTOCOL_VERSION, - capabilities => {prompts => {}, tools => {}}, + capabilities => {prompts => {}, resources => {}, tools => {}}, serverInfo => {name => $self->name, version => $self->version} }; } -sub _handle_prompts_list ($self) { +sub _handle_prompts_list ($self, $context) { my @prompts; - for my $prompt (@{$self->prompts}) { + for my $prompt (@{$self->_prompts($context)}) { my $info = {name => $prompt->name, description => $prompt->description, arguments => $prompt->arguments}; push @prompts, $info; } @@ -97,7 +112,7 @@ my $name = $params->{name} // ''; my $args = $params->{arguments} // {}; return _jsonrpc_error(METHOD_NOT_FOUND, "Prompt '$name' not found") - unless my $prompt = first { $_->name eq $name } @{$self->prompts}; + unless my $prompt = first { $_->name eq $name } @{$self->_prompts($context)}; return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments') if $prompt->validate_input($args); my $result = $prompt->call($args, $context); @@ -105,11 +120,36 @@ return _jsonrpc_response($result, $id); } +sub _handle_resources_list ($self, $context) { + my @resources; + for my $resource (@{$self->_resources($context)}) { + my $info = { + uri => $resource->uri, + name => $resource->name, + description => $resource->description, + mimeType => $resource->mime_type + }; + push @resources, $info; + } + + return {resources => \@resources}; +} + +sub _handle_resources_read ($self, $params, $id, $context) { + my $uri = $params->{uri} // ''; + return _jsonrpc_error(RESOURCE_NOT_FOUND, 'Resource not found') + unless my $resource = first { $_->uri eq $uri } @{$self->_resources($context)}; + + my $result = $resource->call($context); + return $result->then(sub { _jsonrpc_response($_[0], $id) }) if blessed($result) && $result->isa('Mojo::Promise'); + return _jsonrpc_response($result, $id); +} + sub _handle_tools_call ($self, $params, $id, $context) { my $name = $params->{name} // ''; my $args = $params->{arguments} // {}; return _jsonrpc_error(METHOD_NOT_FOUND, "Tool '$name' not found") - unless my $tool = first { $_->name eq $name } @{$self->tools}; + unless my $tool = first { $_->name eq $name } @{$self->_tools($context)}; return _jsonrpc_error(INVALID_PARAMS, 'Invalid arguments') if $tool->validate_input($args); my $result = $tool->call($args, $context); @@ -117,9 +157,9 @@ return _jsonrpc_response($result, $id); } -sub _handle_tools_list ($self) { +sub _handle_tools_list ($self, $context) { my @tools; - for my $tool (@{$self->tools}) { + for my $tool (@{$self->_tools($context)}) { my $info = {name => $tool->name, description => $tool->description, inputSchema => $tool->input_schema}; if (my $output_schema = $tool->output_schema) { $info->{outputSchema} = $output_schema } push @tools, $info; @@ -136,6 +176,24 @@ return {jsonrpc => '2.0', id => $id, result => $result}; } +sub _prompts ($self, $context) { + my $prompts = [@{$self->prompts}]; + $self->emit('prompts', $prompts, $context); + return $prompts; +} + +sub _resources ($self, $context) { + my $resources = [@{$self->resources}]; + $self->emit('resources', $resources, $context); + return $resources; +} + +sub _tools ($self, $context) { + my $tools = [@{$self->tools}]; + $self->emit('tools', $tools, $context); + return $tools; +} + 1; =encoding utf8 @@ -167,12 +225,44 @@ } ); + $server->resource( + uri => 'file:///example.txt', + name => 'example', + description => 'A simple text resource', + mime_type => 'text/plain', + code => sub ($resource) { + return 'This is an example resource content.'; + } + ); + $server->to_stdio; =head1 DESCRIPTION L<MCP::Server> is an MCP (Model Context Protocol) server. +=head1 EVENTS + +L<MCP::Server> inherits all events from L<Mojo::EventEmitter> and emits the following new ones. + +=head2 prompts + + $server->on(prompts => sub ($server, $prompts, $context) { ... }); + +Emitted whenever the list of prompts is accessed. + +=head2 resources + + $server->on(resources => sub ($server, $resources, $context) { ... }); + +Emitted whenever the list of resources is accessed. + +=head2 tools + + $server->on(tools => sub ($server, $tools, $context) { ... }); + +Emitted whenever the list of tools is accessed. + =head1 ATTRIBUTES L<MCP::Server> implements the following attributes. @@ -184,6 +274,20 @@ The name of the server, used for identification. +=head2 prompts + + my $prompts = $server->prompts; + $server = $server->prompts([MCP::Prompt->new]); + +An array reference containing registered prompts. + +=head2 resources + + my $resources = $server->resources; + $server = $server->resources([MCP::Resource->new]); + +An array reference containing registered resources. + =head2 tools my $tools = $server->tools; @@ -207,7 +311,7 @@ =head1 METHODS -L<MCP::Tool> inherits all methods from L<Mojo::Base> and implements the following new ones. +L<MCP::Tool> inherits all methods from L<Mojo::EventEmitter> and implements the following new ones. =head2 handle @@ -226,6 +330,18 @@ Register a new prompt with the server. +=head2 resource + + my $resource = $server->resource( + uri => 'file://my_resource', + name => 'sample_resource', + description => 'A sample resource', + mime_type => 'text/plain', + code => sub ($resource) { ... } + ); + +Register a new resource with the server. + =head2 to_action my $action = $server->to_action; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP/Tool.pm new/MCP-0.06/lib/MCP/Tool.pm --- old/MCP-0.05/lib/MCP/Tool.pm 2025-08-04 14:41:24.722246438 +0200 +++ new/MCP-0.06/lib/MCP/Tool.pm 2025-12-04 15:39:51.000000000 +0100 @@ -12,6 +12,13 @@ has name => 'tool'; has 'output_schema'; +sub audio_result ($self, $audio, $options = {}, $is_error = 0) { + return { + content => [{type => 'audio', data => b64_encode($audio, ''), mimeType => $options->{mime_type} // 'audio/wav'}], + isError => $is_error ? true : false + }; +} + sub call ($self, $args, $context) { local $self->{context} = $context; my $result = $self->code->($self, $args); @@ -33,6 +40,20 @@ }; } +sub resource_link_result ($self, $uri, $options = {}, $is_error = 0) { + return { + content => [{ + type => 'resource_link', + uri => $uri, + name => $options->{name} // '', + description => $options->{description} // '', + mimeType => $options->{mime_type} // 'text/plain', + annotations => $options->{annotations} // {} + }], + isError => $is_error ? true : false + }; +} + sub structured_result ($self, $data, $is_error = 0) { my $result = $self->text_result(to_json($data), $is_error); $result->{structuredContent} = $data; @@ -119,6 +140,24 @@ L<MCP::Tool> inherits all methods from L<Mojo::Base> and implements the following new ones. +=head2 audio_result + + my $result = $tool->audio_result($bytes, $options, $is_error); + +Returns an audio result in the expected format, optionally marking it as an error. + +These options are currently available: + +=over 2 + +=item mime_type + + mime_type => 'audio/wav' + +Specifies the MIME type of the audio, defaults to C<audio/wav>. + +=back + =head2 call my $result = $tool->call($args, $context); @@ -140,7 +179,7 @@ Returns an image result in the expected format, optionally marking it as an error. -hese options are currently available: +These options are currently available: =over 2 @@ -154,7 +193,43 @@ mime_type => 'image/png' -Specifies the MIME type of the image, defaults to 'image/png'. +Specifies the MIME type of the image, defaults to C<image/png>. + +=back + +=head2 resource_link_result + + my $result = $tool->resource_link_result($uri, $options, $is_error); + +Returns a resource link result in the expected format, optionally marking it as an error. + +These options are currently available: + +=over 2 + +=item annotations + + annotations => {audience => ['user']} + +Annotations for the resource link. + +=item description + + description => 'A brief description of the resource' + +Description of the resource. + +=item mime_type + + mime_type => 'text/x-perl' + +Specifies the MIME type of the resource, defaults to C<text/plain>. + +=item name + + name => 'Resource Name' + +Name of the resource. =back diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/lib/MCP.pm new/MCP-0.06/lib/MCP.pm --- old/MCP-0.05/lib/MCP.pm 2025-08-28 15:18:09.748755798 +0200 +++ new/MCP-0.06/lib/MCP.pm 2025-09-30 12:57:35.000000000 +0200 @@ -1,7 +1,7 @@ package MCP; use Mojo::Base -base, -signatures; -our $VERSION = '0.05'; +our $VERSION = '0.06'; 1; Binary files old/MCP-0.05/t/apps/empty.wav and new/MCP-0.06/t/apps/empty.wav differ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/t/apps/lite_app.pl new/MCP-0.06/t/apps/lite_app.pl --- old/MCP-0.05/t/apps/lite_app.pl 2025-08-28 15:47:20.079204872 +0200 +++ new/MCP-0.06/t/apps/lite_app.pl 2025-12-05 13:45:02.000000000 +0100 @@ -51,6 +51,24 @@ } ); $server->tool( + name => 'generate_audio', + description => 'Generate audio from text', + input_schema => {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, + code => sub ($tool, $args) { + my $audio = curfile->sibling('empty.wav')->slurp; + return $tool->audio_result($audio); + } +); +$server->tool( + name => 'find_resource', + description => 'Find a resource for the given text', + input_schema => {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, + code => sub ($tool, $args) { + my $uri = 'file:///path/to/resource.txt'; + return $tool->resource_link_result($uri, {name => 'sample', description => 'An example resource'}); + } +); +$server->tool( name => 'current_weather', description => 'Get current weather data for a location', input_schema => { @@ -73,6 +91,7 @@ return $tool->structured_result({temperature => 19, conditions => 'Raining', humidity => 80}); } ); + $server->prompt( name => 'time', description => 'Tell the user the time', @@ -102,6 +121,37 @@ } ); +$server->resource( + name => 'static_text', + description => 'A static text resource', + uri => 'file:///path/to/static.txt', + mime_type => 'text/plain', + code => sub ($resource) { + return "This is a static text resource."; + } +); +$server->resource( + uri => 'file:///path/to/image.png', + name => 'static_image', + description => 'A static image resource', + mime_type => 'image/png', + code => sub ($resource) { + my $image = curfile->sibling('mojolicious.png')->slurp; + return $resource->binary_resource($image); + } +); +$server->resource( + uri => 'file:///path/to/async.txt', + name => 'async_text', + description => 'An asynchronous text resource', + mime_type => 'text/plain', + code => sub ($resource) { + my $promise = Mojo::Promise->new; + Mojo::IOLoop->timer(0.5 => sub { $promise->resolve("This is an asynchronous text resource.") }); + return $promise; + } +); + any '/mcp' => $server->to_action; get '/' => {text => 'Hello MCP!'}; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/t/lite_app.t new/MCP-0.06/t/lite_app.t --- old/MCP-0.05/t/lite_app.t 2025-08-28 16:02:01.351224139 +0200 +++ new/MCP-0.06/t/lite_app.t 2025-12-05 13:45:49.000000000 +0100 @@ -26,10 +26,11 @@ is $result->{protocolVersion}, PROTOCOL_VERSION, 'protocol version'; is $result->{serverInfo}{name}, 'PerlServer', 'server name'; is $result->{serverInfo}{version}, '1.0.0', 'server version'; - ok $result->{capabilities}, 'has capabilities'; - ok $result->{capabilities}{prompts}, 'has prompts capability'; - ok $result->{capabilities}{tools}, 'has tools capability'; - ok $client->session_id, 'session id set'; + ok $result->{capabilities}, 'has capabilities'; + ok $result->{capabilities}{prompts}, 'has prompts capability'; + ok $result->{capabilities}{resources}, 'has resources capability'; + ok $result->{capabilities}{tools}, 'has tools capability'; + ok $client->session_id, 'session id set'; }; subtest 'Ping' => sub { @@ -63,14 +64,24 @@ is_deeply $result->{tools}[4]{inputSchema}, {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, 'tool input schema'; ok !exists($result->{tools}[4]{outputSchema}), 'no output schema'; - is $result->{tools}[5]{name}, 'current_weather', 'tool name'; - is $result->{tools}[5]{description}, 'Get current weather data for a location', 'tool description'; + is $result->{tools}[5]{name}, 'generate_audio', 'tool name'; + is $result->{tools}[5]{description}, 'Generate audio from text', 'tool description'; + is_deeply $result->{tools}[5]{inputSchema}, + {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, 'tool input schema'; + ok !exists($result->{tools}[5]{outputSchema}), 'no output schema'; + is $result->{tools}[6]{name}, 'find_resource', 'tool name'; + is $result->{tools}[6]{description}, 'Find a resource for the given text', 'tool description'; + is_deeply $result->{tools}[6]{inputSchema}, + {type => 'object', properties => {text => {type => 'string'}}, required => ['text']}, 'tool input schema'; + ok !exists($result->{tools}[6]{outputSchema}), 'no output schema'; + is $result->{tools}[7]{name}, 'current_weather', 'tool name'; + is $result->{tools}[7]{description}, 'Get current weather data for a location', 'tool description'; my $input_schema = { type => 'object', properties => {location => {type => 'string', description => 'City name or zip code'}}, required => ['location'] }; - is_deeply $result->{tools}[5]{inputSchema}, $input_schema, 'tool input schema'; + is_deeply $result->{tools}[7]{inputSchema}, $input_schema, 'tool input schema'; my $output_schema = { type => 'object', properties => { @@ -80,8 +91,8 @@ }, required => ['temperature', 'conditions', 'humidity'] }; - is_deeply $result->{tools}[5]{outputSchema}, $output_schema, 'tool output schema'; - is $result->{tools}[6], undef, 'no more tools'; + is_deeply $result->{tools}[7]{outputSchema}, $output_schema, 'tool output schema'; + is $result->{tools}[8], undef, 'no more tools'; }; subtest 'Tool call' => sub { @@ -127,6 +138,21 @@ is_deeply $result->{content}[0]{annotations}, {audience => ['user']}, 'tool call image annotations'; }; + subtest 'Tool call (audio)' => sub { + my $result = $client->call_tool('generate_audio', {text => 'a cat?'}); + is $result->{content}[0]{mimeType}, 'audio/wav', 'tool call audio type'; + is b($result->{content}[0]{data})->b64_decode->md5_sum, 'e5de045688efc9777361ee3f7d47551d', + 'tool call audio result'; + }; + + subtest 'Tool call (resource link)' => sub { + my $result = $client->call_tool('find_resource', {text => 'a cat?'}); + is $result->{content}[0]{uri}, 'file:///path/to/resource.txt', 'tool call resource uri'; + is $result->{content}[0]{name}, 'sample', 'tool call resource name'; + is $result->{content}[0]{description}, 'An example resource', 'tool call resource description'; + is $result->{content}[0]{mimeType}, 'text/plain', 'tool call resource mime type'; + }; + subtest 'Tool call (structured)' => sub { my $result = $client->call_tool('current_weather', {location => 'Bremen'}); my $json = from_json($result->{content}[0]{text}); @@ -215,6 +241,49 @@ eval { $client->get_prompt('prompt_echo_async', {just => 'a test'}) }; like $@, qr/Error -32602: Invalid arguments/, 'right error'; }; + + subtest 'List resources' => sub { + my $result = $client->list_resources; + is $result->{resources}[0]{name}, 'static_text', 'resource name'; + is $result->{resources}[0]{description}, 'A static text resource', 'resource description'; + is $result->{resources}[0]{uri}, 'file:///path/to/static.txt', 'resource uri'; + is $result->{resources}[0]{mimeType}, 'text/plain', 'resource mime type'; + is $result->{resources}[1]{name}, 'static_image', 'resource name'; + is $result->{resources}[1]{description}, 'A static image resource', 'resource description'; + is $result->{resources}[1]{uri}, 'file:///path/to/image.png', 'resource uri'; + is $result->{resources}[1]{mimeType}, 'image/png', 'resource mime type'; + is $result->{resources}[2]{name}, 'async_text', 'resource name'; + is $result->{resources}[2]{description}, 'An asynchronous text resource', 'resource description'; + is $result->{resources}[2]{uri}, 'file:///path/to/async.txt', 'resource uri'; + is $result->{resources}[2]{mimeType}, 'text/plain', 'resource mime type'; + is $result->{resources}[3], undef, 'no more resources'; + }; + + subtest 'Read resource (text)' => sub { + my $result = $client->read_resource('file:///path/to/static.txt'); + is $result->{contents}[0]{uri}, 'file:///path/to/static.txt', 'resource uri'; + is $result->{contents}[0]{mimeType}, 'text/plain', 'resource mime type'; + is $result->{contents}[0]{text}, 'This is a static text resource.', 'resource text'; + }; + + subtest 'Read resource (image)' => sub { + my $result = $client->read_resource('file:///path/to/image.png'); + is $result->{contents}[0]{uri}, 'file:///path/to/image.png', 'resource uri'; + is $result->{contents}[0]{mimeType}, 'image/png', 'resource mime type'; + is b($result->{contents}[0]{blob})->b64_decode->md5_sum, 'f55ea29e32455f6314ecc8b5c9f0590b', 'resource image data'; + }; + + subtest 'Read resource (async)' => sub { + my $result = $client->read_resource('file:///path/to/async.txt'); + is $result->{contents}[0]{uri}, 'file:///path/to/async.txt', 'resource uri'; + is $result->{contents}[0]{mimeType}, 'text/plain', 'resource mime type'; + is $result->{contents}[0]{text}, 'This is an asynchronous text resource.', 'resource text'; + }; + + subtest 'Invalid resource uri' => sub { + eval { $client->read_resource('file://whatever') }; + like $@, qr/Error -32002: Resource not found/, 'right error'; + }; }; done_testing; diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/MCP-0.05/t/session_specific_app.t new/MCP-0.06/t/session_specific_app.t --- old/MCP-0.05/t/session_specific_app.t 1970-01-01 01:00:00.000000000 +0100 +++ new/MCP-0.06/t/session_specific_app.t 2025-12-05 13:47:36.000000000 +0100 @@ -0,0 +1,170 @@ +use Mojo::Base -strict, -signatures; + +use Test::More; + +use Mojolicious::Lite; +use Test::Mojo; +use MCP::Client; +use MCP::Server; + +my $server = MCP::Server->new; + +$server->tool( + name => 'user_tool', + code => sub ($tool, $args) { + return 'Hello user!'; + } +); +$server->tool( + name => 'admin_tool', + code => sub ($tool, $args) { + return 'Hello admin!'; + } +); +$server->on( + tools => sub ($server, $tools, $context) { + my $role = $context->{controller}->stash('role'); + return if $role eq 'admin'; + @$tools = grep { $_->{name} ne 'admin_tool' } @$tools; + } +); + +$server->prompt( + name => 'user_prompt', + code => sub ($prompt, $args) { + return 'This is a user prompt'; + } +); +$server->prompt( + name => 'admin_prompt', + code => sub ($prompt, $args) { + return 'This is an admin prompt'; + } +); +$server->on( + prompts => sub ($server, $prompts, $context) { + my $role = $context->{controller}->stash('role'); + return if $role eq 'admin'; + @$prompts = grep { $_->{name} ne 'admin_prompt' } @$prompts; + } +); + +$server->resource( + uri => 'file:///user_resource', + code => sub ($resource) { + return 'User resource content'; + } +); +$server->resource( + uri => 'file:///admin_resource', + code => sub ($resource) { + return 'Admin resource content'; + } +); +$server->on( + resources => sub ($server, $resources, $context) { + my $role = $context->{controller}->stash('role'); + return if $role eq 'admin'; + @$resources = grep { $_->{uri} ne 'file:///admin_resource' } @$resources; + } +); + +get '/' => {text => 'Hello MCP!'}; + +# Fake authentication +under sub ($c) { + my $role = $c->param('role'); + $c->stash(role => $role); + return 1; +}; + +any '/mcp' => $server->to_action; + +my $t = Test::Mojo->new; + +subtest 'Normal HTTP endpoint' => sub { + $t->get_ok('/')->status_is(200)->content_like(qr/Hello MCP!/); +}; + +subtest 'MCP endpoint' => sub { + subtest 'Admin user' => sub { + my $client = MCP::Client->new(ua => $t->ua, url => $t->ua->server->url->path('/mcp')->query(role => 'admin')); + $client->initialize_session; + + subtest 'Tools' => sub { + my $result = $client->list_tools; + is $result->{tools}[0]{name}, 'user_tool', 'user tool present'; + is $result->{tools}[1]{name}, 'admin_tool', 'admin tool present'; + is $result->{tools}[2], undef, 'no more tools'; + + my $user_result = $client->call_tool('user_tool'); + is $user_result->{content}[0]{text}, 'Hello user!', 'user tool call result'; + my $admin_result = $client->call_tool('admin_tool'); + is $admin_result->{content}[0]{text}, 'Hello admin!', 'admin tool call result'; + }; + + subtest 'Prompts' => sub { + my $result = $client->list_prompts; + is $result->{prompts}[0]{name}, 'user_prompt', 'user prompt present'; + is $result->{prompts}[1]{name}, 'admin_prompt', 'admin prompt present'; + is $result->{prompts}[2], undef, 'no more prompts'; + + my $user_prompt = $client->get_prompt('user_prompt'); + is $user_prompt->{messages}[0]{content}[0]{text}, 'This is a user prompt', 'user prompt result'; + my $admin_prompt = $client->get_prompt('admin_prompt'); + is $admin_prompt->{messages}[0]{content}[0]{text}, 'This is an admin prompt', 'admin prompt result'; + }; + + subtest 'Resources' => sub { + my $result = $client->list_resources; + is $result->{resources}[0]{uri}, 'file:///user_resource', 'user resource present'; + is $result->{resources}[1]{uri}, 'file:///admin_resource', 'admin resource present'; + is $result->{resources}[2], undef, 'no more resources'; + + my $user_resource = $client->read_resource('file:///user_resource'); + is $user_resource->{contents}[0]{text}, 'User resource content', 'user resource result'; + my $admin_resource = $client->read_resource('file:///admin_resource'); + is $admin_resource->{contents}[0]{text}, 'Admin resource content', 'admin resource result'; + }; + }; + + subtest 'Normal user' => sub { + my $client = MCP::Client->new(ua => $t->ua, url => $t->ua->server->url->path('/mcp')->query(role => 'user')); + $client->initialize_session; + + subtest 'Tools' => sub { + my $result = $client->list_tools; + is $result->{tools}[0]{name}, 'user_tool', 'user tool present'; + is $result->{tools}[1], undef, 'no more tools'; + + my $user_result = $client->call_tool('user_tool'); + is $user_result->{content}[0]{text}, 'Hello user!', 'user tool call result'; + eval { $client->call_tool('admin_tool', {}) }; + like $@, qr/Error -32601: Tool 'admin_tool' not found/, 'right error'; + }; + + subtest 'Prompts' => sub { + my $result = $client->list_prompts; + is $result->{prompts}[0]{name}, 'user_prompt', 'user prompt present'; + is $result->{prompts}[1], undef, 'no more prompts'; + + my $user_prompt = $client->get_prompt('user_prompt'); + is $user_prompt->{messages}[0]{content}[0]{text}, 'This is a user prompt', 'user prompt result'; + eval { $client->get_prompt('admin_prompt') }; + like $@, qr/Error -32601: Prompt 'admin_prompt' not found/, 'right error'; + }; + + subtest 'Resources' => sub { + my $result = $client->list_resources; + is $result->{resources}[0]{uri}, 'file:///user_resource', 'user resource present'; + is $result->{resources}[1], undef, 'no more resources'; + + my $user_resource = $client->read_resource('file:///user_resource'); + is $user_resource->{contents}[0]{text}, 'User resource content', 'user resource result'; + eval { $client->read_resource('file:///admin_resource') }; + like $@, qr/Error -32002: Resource not found/, 'right error'; + }; + }; +}; + +done_testing; ++++++ _scmsync.obsinfo ++++++ --- /var/tmp/diff_new_pack.pzC3BO/_old 2025-12-20 21:49:49.619477715 +0100 +++ /var/tmp/diff_new_pack.pzC3BO/_new 2025-12-20 21:49:49.655479206 +0100 @@ -1,6 +1,6 @@ -mtime: 1759776480 -commit: e21f3db092ea60701794b7a8b2d24c37925e3eb2ca3ccdb614af427f82f125d4 +mtime: 1765258526 +commit: 3068da88f5a137c3414869bda94371d8461f73f48dbc4b15382687d00ce8f5ec url: https://src.opensuse.org/perl/perl-MCP.git -revision: e21f3db092ea60701794b7a8b2d24c37925e3eb2ca3ccdb614af427f82f125d4 +revision: 3068da88f5a137c3414869bda94371d8461f73f48dbc4b15382687d00ce8f5ec projectscmsync: https://src.opensuse.org/perl/_ObsPrj ++++++ build.specials.obscpio ++++++ ++++++ build.specials.obscpio ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/.gitignore new/.gitignore --- old/.gitignore 1970-01-01 01:00:00.000000000 +0100 +++ new/.gitignore 2025-12-10 11:08:39.000000000 +0100 @@ -0,0 +1 @@ +.osc
