File Coverage

blib/lib/MCP/Prompt.pm
Criterion Covered Total %
statement 40 40 100.0
branch 8 10 80.0
condition 4 6 66.6
subroutine 7 7 100.0
pod 3 3 100.0
total 62 66 93.9


line stmt bran cond sub pod time code
1             package MCP::Prompt;
2 4     4   21 use Mojo::Base 'MCP::Primitive', -signatures;
  4         4  
  4         23  
3              
4 4     4   412 use Scalar::Util qw(blessed);
  4         7  
  4         1922  
5              
6             has arguments => sub { [] };
7             has code => sub { die 'Prompt code not implemented' };
8             has description => 'Generic MCP prompt';
9             has name => 'prompt';
10              
11 9     9 1 15 sub call ($self, $args, $context) {
  9         12  
  9         9  
  9         11  
  9         12  
12 9         23 local $self->{context} = $context;
13 9         27 my $result = $self->code->($self, $args);
14 9 100 66 2   302 return $result->then(sub { $self->_type_check($_[0]) }) if blessed($result) && $result->isa('Mojo::Promise');
  2         1001234  
15 7         19 return $self->_type_check($result);
16             }
17              
18 9     9 1 117 sub text_prompt ($self, $text, $role = 'user', $description = undef) {
  9         13  
  9         15  
  9         16  
  9         14  
  9         15  
19 9         110 my $result = {messages => [{role => $role, content => {type => 'text', text => "$text"}}]};
20 9 100       29 $result->{description} = $description if defined $description;
21 9         34 return $result;
22             }
23              
24 10     10 1 15 sub validate_input ($self, $args) {
  10         21  
  10         13  
  10         12  
25 10         14 for my $arg (@{$self->arguments}) {
  10         21  
26 4 50       26 next unless $arg->{required};
27 4 100       20 return 1 unless exists $args->{$arg->{name}};
28             }
29 9         46 return 0;
30             }
31              
32 9     9   15 sub _type_check ($self, $result) {
  9         14  
  9         12  
  9         11  
33 9 50 66     34 return $result if ref $result eq 'HASH' && exists $result->{messages};
34 8         28 return $self->text_prompt($result);
35             }
36              
37             1;
38              
39             =encoding utf8
40              
41             =head1 NAME
42              
43             MCP::Prompt - Prompt container
44              
45             =head1 SYNOPSIS
46              
47             use MCP::Prompt;
48              
49             my $prompt = MCP::Prompt->new;
50              
51             =head1 DESCRIPTION
52              
53             L is a container for prompts.
54              
55             =head1 ATTRIBUTES
56              
57             L implements the following attributes.
58              
59             =head2 arguments
60              
61             my $args = $prompt->arguments;
62             $prompt = $prompt->arguments([{name => 'foo', description => 'Whatever', required => 1}]);
63              
64             Arguments for the prompt.
65              
66             =head2 code
67              
68             my $code = $prompt->code;
69             $prompt = $prompt->code(sub { ... });
70              
71             Prompt code.
72              
73             =head2 description
74              
75             my $description = $prompt->description;
76             $prompt = $prompt->description('A brief description of the prompt');
77              
78             Description of the prompt.
79              
80             =head2 name
81              
82             my $name = $prompt->name;
83             $prompt = $prompt->name('my_prompt');
84              
85             Name of the Prompt.
86              
87             =head1 METHODS
88              
89             L inherits all methods from L and implements the following new ones.
90              
91             =head2 call
92              
93             my $result = $prompt->call($args, $context);
94              
95             Calls the prompt with the given arguments and context, returning a result. The result can be a promise or a direct
96             value.
97              
98             =head2 text_prompt
99              
100             my $result = $prompt->text_prompt('Some text');
101             my $result = $prompt->text_prompt('Some text', $role);
102             my $result = $prompt->text_prompt('Some text', $role, $description);
103              
104             Returns a text prompt in the expected format.
105              
106             =head2 validate_input
107              
108             my $bool = $prompt->validate_input($args);
109              
110             Validates the input arguments. Returns true if validation failed.
111              
112             =head1 SEE ALSO
113              
114             L, L, L.
115              
116             =cut