view release on metacpan or search on metacpan
- move forward towards extendability.
1.04_07 2017-09-05T22:47:42+02:00 (443eca4 => abeltje)
- (abeltje, Tue, 5 Sep 2017 22:47:42 +0200) Autocommit for distribution
Dancer::Plugin::RPC 1.04_07 (test)
1.04_06 2017-09-04T18:45:07+02:00 (b8eb5b9 => abeltje)
- (abeltje, Mon, 4 Sep 2017 18:45:07 +0200) Autocommit for distribution
Dancer::Plugin::RPC 1.04_06 (test)
- (abeltje, Tue, 5 Sep 2017 22:37:26 +0200) Introduce explicit endpoints
for POD-publishing.
- The pod-directive for publishing now has a third (optional) part to
- specify an endpoint. This way one can have code for multiple
endpoints
- in the same file.
- =for <plugin> <rpc-name> <code-name>[ <endpoint>]
1.04_05 2017-09-02T20:03:22+02:00 (e763554 => abeltje)
- (abeltje, Sat, 2 Sep 2017 20:03:22 +0200) Autocommit for distribution
Dancer::Plugin::RPC 1.04_05 (same)
- (abeltje, Sun, 3 Sep 2017 11:41:50 +0200) Fix
Dancer::RPCPlugin::MethodList::list_methods interface
- Now it is like the Dancer2 version with positional parameters.
- (abeltje, Mon, 4 Sep 2017 18:41:21 +0200) Fix agent-identifier in
{
"abstract" : "Configure endpoints for XMLRPC, JSONRPC and RESTRPC procedures",
"author" : [
"Abe Timmerman <abeltje@cpan.org>"
],
"dynamic_config" : 1,
"generated_by" : "ExtUtils::MakeMaker version 7.64, CPAN::Meta::Converter version 2.150010",
"license" : [
"perl_5"
],
"meta-spec" : {
"url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
---
abstract: 'Configure endpoints for XMLRPC, JSONRPC and RESTRPC procedures'
author:
- 'Abe Timmerman <abeltje@cpan.org>'
build_requires:
Dancer: '1.31'
JSON: '2.0'
Moo: '2'
Params::ValidationCompiler: '0.24'
RPC::XML: '0.56'
Test::Fatal: '0.010'
Test::More: '0.88'
# NAME
Dancer::Plugin::RPC - Configure endpoints for XMLRPC, JSONRPC and RESTRPC procedures
# DESCRIPTION
This module contains plugins for [Dancer](https://metacpan.org/pod/Dancer): [Dancer::Plugin::RPC::XMLRPC](https://metacpan.org/pod/Dancer%3A%3APlugin%3A%3ARPC%3A%3AXMLRPC),
[Dancer::Plugin::RPC::JSONRPC](https://metacpan.org/pod/Dancer%3A%3APlugin%3A%3ARPC%3A%3AJSONRPC) and [Dancer::Plugin::RPC::RESTRPC](https://metacpan.org/pod/Dancer%3A%3APlugin%3A%3ARPC%3A%3ARESTRPC).
## Dancer::Plugin::RPC::XMLRPC
This plugin exposes the new keyword `xmlrpc` that is followed by 2 arguments:
the endpoint and the arguments to configure the xmlrpc-calls at this endpoint.
## Dancer::Plugin::RPC::JSONRPC
This plugin exposes the new keyword `jsonrpc` that is followed by 2 arguments:
the endpoint and the arguments to configure the jsonrpc-calls at this endpoint.
## Dancer::Plugin::RPC::RESTRPC
This plugin exposes the new keyword `restrpc` that is followed by 2 arguments:
the endpoint and the arguments to configure the restrpc-calls at this endpoint.
## General arguments to xmlrpc/jsonrpc/restrpc
The dispatch table is build by endpoint.
### publish => <config|pod|$coderef>
- publish => **config**
The **arguments** argument should be empty for this publishing type.
The dispatch table is build from the YAML-config:
```yaml
plugins:
'RPC::XMLRPC':
'/endpoint1':
'Module::Name1':
method1: sub1
method2: sub2
'Module::Name2':
method3: sub3
'/endpoint2':
'Module::Name3':
method4: sub4
```
- publish => **pod**
The **arguments** argument must be an Arrayref with module names. The
POD-directive must be in the same file as the code!
The dispatch table is build by parsing the POD for `=for xmlrpc`,
`=for jsonrpc` or `=for restrpc`.
Returns for failure: `callback_fail(error_code => $code, error_message => $msg)`
This is useful for eg ACL checking.
In the scope of the callback-function you will have the variable
`$Dancer::RPCPlugin::ROUTE_INFO`, a hashref:
```perl
local $Dancer::RPCPlugin::ROUTE_INFO = {
plugin => PLUGIN_NAME,
endpoint => $endpoint,
rpc_method => $method_name,
full_path => request->path,
http_method => $http_method,
};
```
Other plugins may want to put extra information in there to help you decide if
this request should even be honoured.
### code\_wrapper => $coderef
example/bin/do-rpc view on Meta::CPAN
with 'Client::HTTP';
use JSON;
use URI;
use Data::Dumper;
sub call {
my $self = shift;
my $call = shift;
my $http_method = shift || 'GET';
(my $endpoint = $self->base_uri->as_string) =~ s{/+$}{};
$endpoint .= "/$call" if $call;
my $request = @_ ? encode_json(shift) : '';
$self->log_debug("$http_method: $endpoint => $request");
my $response = $self->client->request(
$http_method => $endpoint,
{
headers => {
'Content-Type' => 'application/json',
'Content-Length' => length($request),
},
content => $request,
}
);
local $Data::Dumper::Indent = 1;
$self->log_trace(Dumper($response));
example/lib/Client/MetaCpan.pm view on Meta::CPAN
with 'Client::HTTP';
sub call {
my $self = shift;
my ($query) = @_;
$query =~ s{::}{-}g;
my $params = $http->www_form_urlencode("q=$query");
(my $endpoint = $self->base_uri->as_string) =~ s{/+$}{};
my $response = $self->client->get("$endpoint/?$params");
my $content = eval { decode_json($response->{content}) };
return $content if !$@;
return { error => $@, data => $response->{content} };
}
use namespace::autoclean;
1;
=head1 COPYRIGHT
example/lib/Example.pm view on Meta::CPAN
{
my $system_config = Example::EndpointConfig->new(
publish => 'pod',
bread_board => $system_api,
plugin_arguments => {
arguments => ['Example::API::System'],
},
);
for my $plugin (qw/RPC::JSONRPC RPC::RESTRPC RPC::XMLRPC/) {
$system_config->register_endpoint($plugin, '/system');
}
}
{
my $example_config = Example::EndpointConfig->new(
publish => 'config',
bread_board => $example_api,
);
my $plugins = config->{plugins};
for my $plugin (keys %$plugins) {
for my $path (keys %{$plugins->{$plugin}}) {
$example_config->register_endpoint($plugin, $path);
}
}
}
setup_default_route();
1;
example/lib/Example/API/System.pm view on Meta::CPAN
}
=head2 rpc_list_methods()
=for jsonrpc list_methods rpc_list_methods /system
=for restrpc list_methods rpc_list_methods /system
=for xmlrpc list_methods rpc_list_methods /system
Returns a struct for all protocols with all endpoints and functions for that endpoint.
=head1 COPYRIGHT
(c) MMXVII - Abe Timmerman <abeltje@cpan.org>
=cut
example/lib/Example/EndpointConfig.pm view on Meta::CPAN
service 'Client::MetaCpan' => as (
class => 'Client::MetaCpan',
dependencies => {
base_uri => literal config->{base_uri},
),
};
};
),
);
$config->register_endpoint('RPC::JSONRPC' => '/metacpan');
$config->register_endpoint('RPC::XMLRPC' => '/metacpan');
=head1 ATTRIBUTES
=head2 publish [required]
This attribute can have the value of B<config> or B<pod>, it will be bassed to
L<Dancer::Plugin::RPC>
=head2 callback [optional]
example/lib/Example/EndpointConfig.pm view on Meta::CPAN
return $instance->$code(@arguments);
};
}
sub _registrar_for_plugin {
my $self = shift;
my ($plugin) = @_;
return $_plugin_info{$plugin}{registrar} // die "Cannot find plugin '$plugin'";
}
=head2 endpoint_config($path)
Returns a config-hash for the C<Dancer::Plugin::RPC::*> plugins.
=cut
sub endpoint_config {
my $self = shift;
my ($path) = @_;
return {
publish => $self->publish,
code_wrapper => $self->code_wrapper,
(defined $self->callback
? (callback => $self->callback)
: ()
),
(defined $self->plugin_arguments
? (%{ $self->plugin_arguments })
: ()
),
};
}
=head2 register_endpoint($plugin, $path)
=cut
sub register_endpoint {
my $self = shift;
my ($plugin, $path) = @_;
my $registrar = $self->_registrar_for_plugin($plugin);
$registrar->($path, $self->endpoint_config($path));
}
use namespace::autoclean;
1;
=head1 COPYRIGHT
(c) MMXIX - Abe Timmerman <abeltje@cpan.org>
=cut
lib/Dancer/Plugin/RPC.pm view on Meta::CPAN
package Dancer::Plugin::RPC;
use warnings;
use strict;
our $VERSION = '1.11';
# Will be set from the request-handler for the callback scope
our $ROUTE_INFO = {
plugin => undef, # PLUGIN_NAME,
endpoint => undef, # $endpoint,
rpc_method => undef, # $method_name,
full_path => undef, # request->path,
http_method => undef, # $http_method,
};
1;
=head1 NAME
Dancer::Plugin::RPC - Configure endpoints for XMLRPC, JSONRPC and RESTRPC procedures
=head1 DESCRIPTION
This module contains plugins for L<Dancer>: L<Dancer::Plugin::RPC::XMLRPC>,
L<Dancer::Plugin::RPC::JSONRPC> and L<Dancer::Plugin::RPC::RESTRPC>.
=head2 Dancer::Plugin::RPC::XMLRPC
This plugin exposes the new keyword C<xmlrpc> that is followed by 2 arguments:
the endpoint and the arguments to configure the xmlrpc-calls at this endpoint.
=head2 Dancer::Plugin::RPC::JSONRPC
This plugin exposes the new keyword C<jsonrpc> that is followed by 2 arguments:
the endpoint and the arguments to configure the jsonrpc-calls at this endpoint.
=head2 Dancer::Plugin::RPC::RESTRPC
This plugin exposes the new keyword C<restrpc> that is followed by 2 arguments:
the endpoint and the arguments to configure the restrpc-calls at this endpoint.
=head2 General arguments to xmlrpc/jsonrpc/restrpc
The dispatch table is build by endpoint.
=head3 publish => <config|pod|$coderef>
=over
=item publish => B<config>
The dispatch table is build from the YAML-config:
plugins:
'RPC::XMLRPC':
'/endpoint1':
'Module::Name1':
method1: sub1
method2: sub2
'Module::Name2':
method3: sub3
'/endpoint2':
'Module::Name3':
method4: sub4
The B<arguments> argument should be empty for this publishing type.
=item publish => B<pod>
The dispatch table is build by parsing the POD for C<=for xmlrpc>,
C<=for jsonrpc> or C<=for restrpc>.
lib/Dancer/Plugin/RPC.pm view on Meta::CPAN
Returns for failure: C<< callback_fail(error_code => $code, error_message => $msg) >>
This is useful for eg ACL checking.
In the scope of the callback-function you will have the variable
C<$Dancer::RPCPlugin::ROUTE_INFO>, a hashref:
local $Dancer::RPCPlugin::ROUTE_INFO = {
plugin => PLUGIN_NAME,
endpoint => $endpoint,
rpc_method => $method_name,
full_path => request->path,
http_method => $http_method,
};
Other plugins may want to put extra information in there to help you decide if
this request should even be honoured.
=head3 code_wrapper => $coderef
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
use Dancer::RPCPlugin::DispatchMethodList;
use Dancer::RPCPlugin::ErrorResponse;
use Dancer::RPCPlugin::FlattenData;
my %dispatch_builder_map = (
pod => \&build_dispatcher_from_pod,
config => \&build_dispatcher_from_config,
);
register PLUGIN_NAME ,=> sub {
my ($self, $endpoint, $arguments) = plugin_args(@_);
my $publisher;
GIVEN: {
local $_ = $arguments->{publish} // 'config';
exists($dispatch_builder_map{$_}) && do {
$publisher = $dispatch_builder_map{$_};
$arguments->{arguments} = plugin_setting() if $_ eq 'config';
last GIVEN;
};
do {
$publisher = $_;
};
}
my $dispatcher = $publisher->($arguments->{arguments}, $endpoint);
my $lister = Dancer::RPCPlugin::DispatchMethodList->new();
$lister->set_partial(
protocol => PLUGIN_NAME,
endpoint => $endpoint,
methods => [ sort keys %{ $dispatcher } ],
);
my $code_wrapper = $arguments->{code_wrapper}
? $arguments->{code_wrapper}
: sub {
my $code = shift;
my $pkg = shift;
$code->(@_);
};
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
next;
}
my $method_args = $request->{params};
my $start_request = time();
debug("[handle_jsonrpc_call($method_name)] ", $method_args);
my Dancer::RPCPlugin::CallbackResult $continue = eval {
local $Dancer::RPCPlugin::ROUTE_INFO = {
plugin => PLUGIN_NAME,
endpoint => $endpoint,
rpc_method => $method_name,
full_path => request->path,
http_method => uc(request->method),
};
$callback
? $callback->(request(), $method_name, $method_args)
: callback_success();
};
if (my $error = $@) {
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
$response = to_json($responses[0], $jsonise_options);
}
else {
$response = to_json([grep {defined($_->{id})} @responses], $jsonise_options);
}
debug("[jsonrpc_response] ", $response);
return $response;
};
debug("setting route (jsonrpc): $endpoint ", $lister);
post $endpoint, $handle_call;
};
sub unjson {
my ($body) = @_;
my @requests;
my $unjson = from_json($body, {utf8 => 1});
if (ref($unjson) ne 'ARRAY') {
@requests = ($unjson);
}
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
my ($id, $type, $data) = @_;
return {
jsonrpc => '2.0',
id => $id,
$type => $data,
};
}
sub build_dispatcher_from_pod {
my ($pkgs, $endpoint) = @_;
debug("[build_dispatcher_from_pod]");
return dispatch_table_from_pod(
plugin => PLUGIN_NAME,
packages => $pkgs,
endpoint => $endpoint,
);
}
sub build_dispatcher_from_config {
my ($config, $endpoint) = @_;
debug("[build_dispatcher_from_config] $endpoint");
return dispatch_table_from_config(
plugin => PLUGIN_NAME,
config => $config,
endpoint => $endpoint,
);
}
register_plugin;
1;
=head1 NAME
Dancer::Plugin::RPC::JSONRPC - Dancer Plugin to register jsonrpc2 methods.
=head1 SYNOPSIS
In the Controler-bit:
use Dancer::Plugin::RPC::JSONRPC;
jsonrpc '/endpoint' => {
publish => 'pod',
arguments => ['MyProject::Admin']
};
and in the Model-bit (B<MyProject::Admin>):
package MyProject::Admin;
=for jsonrpc rpc.abilities rpc_show_abilities
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
sub rpc_show_abilities {
return {
# datastructure
};
}
1;
=head1 DESCRIPTION
This plugin lets one bind an endpoint to a set of modules with the new B<jsonrpc> keyword.
=head2 jsonrpc '/endpoint' => \%publisher_arguments;
=head3 C<\%publisher_arguments>
=over
=item callback => $coderef [optional]
The callback will be called just before the actual rpc-code is called from the
dispatch table. The arguments are positional: (full_request, method_name).
lib/Dancer/Plugin/RPC/JSONRPC.pm view on Meta::CPAN
The publiser key determines the way one connects the rpc-method name with the actual code.
=over
=item publisher => 'config'
This way of publishing requires you to create a dispatch-table in the app's config YAML:
plugins:
"RPC::JSONRPC":
'/endpoint':
'MyProject::Admin':
admin.someFunction: rpc_admin_some_function_name
'MyProject::User':
user.otherFunction: rpc_user_other_function_name
The Config-publisher doesn't use the C<arguments> value of the C<%publisher_arguments> hash.
=item publisher => 'pod'
This way of publishing enables one to use a special POD directive C<=for jsonrpc>
lib/Dancer/Plugin/RPC/RESTRPC.pm view on Meta::CPAN
};
do {
$publisher = $_;
};
}
my $dispatcher = $publisher->($arguments->{arguments}, $base_url);
my $lister = Dancer::RPCPlugin::DispatchMethodList->new();
$lister->set_partial(
protocol => PLUGIN_NAME,
endpoint => $base_url,
methods => [ sort keys %{ $dispatcher } ],
);
my $code_wrapper = $arguments->{code_wrapper}
? $arguments->{code_wrapper}
: sub {
my $code = shift;
my $pkg = shift;
$code->(@_);
};
lib/Dancer/Plugin/RPC/RESTRPC.pm view on Meta::CPAN
my $response;
my $method_args = request->body
? from_json(request->body)
: undef;
debug("[handle_restrpc_call($method_name)] ", $method_args);
my $start_request = time();
my Dancer::RPCPlugin::CallbackResult $continue = eval {
local $Dancer::RPCPlugin::ROUTE_INFO = {
plugin => PLUGIN_NAME,
endpoint => $base_url,
rpc_method => $method_name,
full_path => request->path,
http_method => uc(request->method),
};
$callback
? $callback->(request(), $method_name, $method_args)
: callback_success();
};
if (my $error = $@) {
lib/Dancer/Plugin/RPC/RESTRPC.pm view on Meta::CPAN
}
info( sprintf(
"[RPC::RESTRPC] request for %s took %.4fs",
$method_name, time() - $start_request
));
return to_json($response, $jsonise_options);
};
debug("setting routes (restrpc): $base_url ", $lister);
for my $call (keys %{ $dispatcher }) {
my $endpoint = "$base_url/$call";
post $endpoint, $handle_call;
}
};
sub build_dispatcher_from_pod {
my ($pkgs, $endpoint) = @_;
debug("[build_dispatcher_from_pod]");
return dispatch_table_from_pod(
plugin => 'restrpc',
packages => $pkgs,
endpoint => $endpoint,
);
}
sub build_dispatcher_from_config {
my ($config, $endpoint) = @_;
debug("[build_dispatcher_from_config] ");
return dispatch_table_from_config(
plugin => 'restrpc',
config => $config,
endpoint => $endpoint,
);
}
register_plugin();
true;
=head1 NAME
Dancer::Plugin::RPC::RESTRPC - RESTRPC Plugin for Dancer
lib/Dancer/Plugin/RPC/RESTRPC.pm view on Meta::CPAN
sub rpc_show_abilities {
return {
# datastructure
};
}
1;
=head1 DESCRIPTION
RESTRPC is a simple protocol that uses HTTP-POST to post a JSON-string (with
C<Content-Type: application/json> to an endpoint. This endpoint is the
C<base_url> concatenated with the rpc-method name.
This plugin lets one bind a base_url to a set of modules with the new B<restrpc> keyword.
=head2 restrpc '/base_url' => \%publisher_arguments;
=head3 C<\%publisher_arguments>
=over
lib/Dancer/Plugin/RPC/XMLRPC.pm view on Meta::CPAN
use Dancer::RPCPlugin::FlattenData;
use RPC::XML::ParserFactory;
my %dispatch_builder_map = (
pod => \&build_dispatcher_from_pod,
config => \&build_dispatcher_from_config,
);
register PLUGIN_NAME ,=> sub {
my($self, $endpoint, $arguments) = plugin_args(@_);
my $publisher;
GIVEN: {
local $_ = $arguments->{publish} // 'config';
exists($dispatch_builder_map{$_}) && do {
$publisher = $dispatch_builder_map{$_};
$arguments->{arguments} = plugin_setting() if $_ eq 'config';
last GIVEN;
};
do {
$publisher = $_;
}
}
my $dispatcher = $publisher->($arguments->{arguments}, $endpoint);
my $lister = Dancer::RPCPlugin::DispatchMethodList->new();
$lister->set_partial(
protocol => PLUGIN_NAME,
endpoint => $endpoint,
methods => [ sort keys %{ $dispatcher } ],
);
my $code_wrapper = $arguments->{code_wrapper}
? $arguments->{code_wrapper}
: sub {
my $code = shift;
my $pkg = shift;
$code->(@_);
};
lib/Dancer/Plugin/RPC/XMLRPC.pm view on Meta::CPAN
pass();
}
debug("[handle_xmlrpc_request] Processing: ", request->body);
local $RPC::XML::ENCODING = $RPC::XML::ENCODING ='UTF-8';
my $p = RPC::XML::ParserFactory->new();
my $request = $p->parse(request->body);
my $method_name = $request->name;
if (! exists $dispatcher->{$method_name}) {
warning("$endpoint/#$method_name not found, pass()");
pass();
}
content_type 'text/xml';
my $response;
my @method_args = map $_->value, @{$request->args};
debug("[handle_xmlrpc_call($method_name)] ", \@method_args);
my $start_request = time();
my Dancer::RPCPlugin::CallbackResult $continue = eval {
local $Dancer::RPCPlugin::ROUTE_INFO = {
plugin => PLUGIN_NAME,
endpoint => $endpoint,
rpc_method => $method_name,
full_path => request->path,
http_method => uc(request->method),
};
$callback
? $callback->(request(), $method_name, @method_args)
: callback_success();
};
if (my $error = $@) {
lib/Dancer/Plugin/RPC/XMLRPC.pm view on Meta::CPAN
$response = flatten_data($response);
}
}
info( sprintf(
"[RPC::XMLRPC] request for %s took %.4fs",
$method_name, time() - $start_request
));
return xmlrpc_response($response);
};
debug("setting route (xmlrpc): $endpoint ", $lister);
post $endpoint, $handle_call;
};
sub xmlrpc_response {
my ($data) = @_;
my $response;
if (ref $data eq 'HASH' && exists $data->{faultCode}) {
$response = RPC::XML::response->new(RPC::XML::fault->new(%$data));
}
elsif (grep /^faultCode$/, grep defined $_, @_) {
$response = RPC::XML::response->new(RPC::XML::fault->new(@_));
}
else {
$response = RPC::XML::response->new(@_);
}
debug("[xmlrpc_response] ", $response->as_string);
return $response->as_string;
}
sub build_dispatcher_from_pod {
my ($pkgs, $endpoint) = @_;
debug("[build_dispatcher_from_pod]");
return dispatch_table_from_pod(
plugin => PLUGIN_NAME,
packages => $pkgs,
endpoint => $endpoint,
);
}
sub build_dispatcher_from_config {
my ($config, $endpoint) = @_;
debug("[build_dispatcher_from_config] ");
return dispatch_table_from_config(
plugin => PLUGIN_NAME,
config => $config,
endpoint => $endpoint,
);
}
register_plugin();
true;
=head1 NAME
Dancer::Plugin::RPC::XMLRPC - XMLRPC Plugin for Dancer
=head2 SYNOPSIS
In the Controler-bit:
use Dancer::Plugin::RPC::XMLRPC;
xmlrpc '/endpoint' => {
publish => 'pod',
arguments => ['MyProject::Admin']
};
and in the Model-bit (B<MyProject::Admin>):
package MyProject::Admin;
=for xmlrpc rpc.abilities rpc_show_abilities
lib/Dancer/Plugin/RPC/XMLRPC.pm view on Meta::CPAN
sub rpc_show_abilities {
return {
# datastructure
};
}
1;
=head1 DESCRIPTION
This plugin lets one bind an endpoint to a set of modules with the new B<xmlrpc> keyword.
=head2 xmlrpc '/endpoint' => \%publisher_arguments;
=head3 C<\%publisher_arguments>
=over
=item callback => $coderef [optional]
The callback will be called just before the actual rpc-code is called from the
dispatch table. The arguments are positional: (full_request, method_name).
lib/Dancer/Plugin/RPC/XMLRPC.pm view on Meta::CPAN
The publiser key determines the way one connects the rpc-method name with the actual code.
=over
=item publisher => 'config'
This way of publishing requires you to create a dispatch-table in the app's config YAML:
plugins:
"RPC::XMLRPC":
'/endpoint':
'MyProject::Admin':
admin.someFunction: rpc_admin_some_function_name
'MyProject::User':
user.otherFunction: rpc_user_other_function_name
The Config-publisher doesn't use the C<arguments> value of the C<%publisher_arguments> hash.
=item publisher => 'pod'
This way of publishing enables one to use a special POD directive C<=for xmlrpc>
lib/Dancer/RPCPlugin/DefaultRoute.pm view on Meta::CPAN
Dancer::RPCPlugin::DefaultRoute - Catch bad-requests and send error-response
=head1 SYNOPSIS
use Dancer::RPCPlugin::DefaultRoute;
setup_default_route();
=head1 DESCRIPTION
Implements default endpoint to generate -32601 'method not found'
or 'path not found' error_response for non existing endpoints
=head2 setup_default_route
Installs a Dancer route-handler for C<< any qr{.+} >> which tries to return an
appropriate error response to the requestor.
=head3 Responses
All responeses will have B<status: 200 OK>
lib/Dancer/RPCPlugin/DispatchFromConfig.pm view on Meta::CPAN
use Dancer::RPCPlugin::PluginNames;
use Types::Standard qw/ Int Str StrMatch Any /;
use Params::ValidationCompiler 'validation_for';
sub dispatch_table_from_config {
my $pn_re = Dancer::RPCPlugin::PluginNames->new->regex;
my %args = validation_for(
params => {
plugin => { type => StrMatch[ qr/^$pn_re$/ ] },
config => { type => Any },
endpoint => { type => Str, optional => 0 },
}
)->(@_);
my $config = $args{config}{ $args{endpoint} };
my @pkgs = keys %$config;
my $dispatch;
for my $pkg (@pkgs) {
eval "require $pkg" if $pkg ne 'main';
error("Loading $pkg: $@") if $@;
my @rpc_methods = keys %{ $config->{$pkg} };
for my $rpc_method (@rpc_methods) {
my $subname = $config->{$pkg}{$rpc_method};
debug("[bdfc] $args{endpoint}: $rpc_method => $subname");
if (my $handler = $pkg->can($subname)) {
$dispatch->{$rpc_method} = dispatch_item(
package => $pkg,
code => $handler
);
}
else {
die "Handler not found for $rpc_method: $pkg\::$subname doesn't seem to exist.\n";
}
}
lib/Dancer/RPCPlugin/DispatchFromConfig.pm view on Meta::CPAN
=head3 Parameters
Named:
=over
=item plugin => <xmlrpc|jsonrpc|restrpc>
=item config => $config_from_plugin
=item endpoint => '/endpoint_for_dispatch_table'
=back
=head3 Responses
A (partial) dispatch-table.
=head1 COPYRIGHT
(c) MMXV - Abe Timmerman <abeltje@cpan.org>
lib/Dancer/RPCPlugin/DispatchFromPod.pm view on Meta::CPAN
use Pod::Simple::PullParser;
use Types::Standard qw/ Str StrMatch ArrayRef Object /;
use Params::ValidationCompiler 'validation_for';
sub dispatch_table_from_pod {
my $pn_re = Dancer::RPCPlugin::PluginNames->new->regex;
my %args = validation_for(
params => {
plugin => { type => StrMatch[ qr/^$pn_re$/ ] },
packages => { type => ArrayRef },
endpoint => { type => Str },
}
)->(@_);
my $pp = Pod::Simple::PullParser->new();
$pp->accept_targets($args{plugin});
debug("[dispatch_table_from_pod] for $args{plugin}");
my %dispatch;
for my $package (@{ $args{packages} }) {
eval "require $package;" if $package ne 'main';
if (my $error = $@) {
error("Cannot load '$package': $error");
die "Stopped";
}
my $pkg_dispatch = _parse_file(
package => $package,
endpoint => $args{endpoint},
parser => $pp,
);
@dispatch{keys %$pkg_dispatch} = @{$pkg_dispatch}{keys %$pkg_dispatch};
}
# we don't want "Encountered CODE ref, using dummy placeholder"
# thus we use Data::Dumper::Dumper() directly.
local ($Data::Dumper::Indent, $Data::Dumper::Sortkeys, $Data::Dumper::Terse) = (0, 1, 1);
debug("[dispatch_table_from_pod]->", Data::Dumper::Dumper(\%dispatch));
return \%dispatch;
}
sub _parse_file {
my %args = validation_for(
params => {
package => { type => StrMatch[ qr/^\w[\w:]*$/ ] },
parser => { type => Object },
endpoint => { type => Str },
}
)->(@_);
(my $pkg_as_file = "$args{package}.pm") =~ s{::}{/}g;
my $pkg_file = $INC{$pkg_as_file};
use autodie;
open my $fh, '<', $pkg_file;
my $p = $args{parser};
$p->set_source($fh);
lib/Dancer/RPCPlugin/DispatchFromPod.pm view on Meta::CPAN
next if not ($token->is_start && $token->is_tag('for'));
my $label = $token->attr('target');
my $ntoken = $p->get_token;
while ($ntoken && ! $ntoken->can('text')) { $ntoken = $p->get_token; }
last if !$ntoken;
debug("=for-token $label => ", $ntoken->text);
my ($if_name, $code_name, $ep_name) = split " ", $ntoken->text;
$ep_name //= $args{endpoint};
debug("[build_dispatcher] $args{package}\::$code_name => $if_name ($ep_name)");
next if $ep_name ne $args{endpoint};
my $pkg = $args{package};
if (my $handler = $pkg->can($code_name)) {
$dispatch->{$if_name} = dispatch_item(
package => $pkg,
code => $handler
);
} else {
die "Handler not found for $if_name: $pkg\::$code_name doesn't seem to exist.\n";
}
lib/Dancer/RPCPlugin/DispatchFromPod.pm view on Meta::CPAN
use Dancer::Plugin;
use Dancer::RPCPlugin::DispatchFromPod;
sub dispatch_call {
return dispatch_table_from_pod(%parameters);
}
=head1 DESCRIPTION
Interface to build a (partial) dispatch table from the special pod-directives in the
packages specified and for the optional endpoint specified.
=head2 POD Specifications
One can specify a sub/method to be used for the RPCPlugin by using the
POD directive C<=for> followed by the rpc-protocol supported by this plugin-set.
One of B<jsonrpc>, B<restrpc> and B<xmlrpc>.
=for <protocol> <rpc-name> <real-code-name>[ <endpoint>]
=over
=item B<< <protocol> >> must be one of <jsonrpc|restrpc|xmlrpc>
=item B<< <rpc-name> >> is the name used by the rpc-interface to execute this
call, different protocols may use diffent 'rpc-name's to reflect the nature of
the protocol.
=item B<< <real-code-name> >> is the name of the sub/method
=item B<< <endpoint> >> this optional argument is needed for files/packages that
have code for different endpoints.
=back
The pod-directive must be in the same file the code it refers to is.
Make sure the partial dispatch table for a single endpoint is build in a single pass.
=head1 EXPORTS
=head2 dispatch_table_from_pod(%arguments)
=head3 Parameters
Named:
=over
=item plugin => <jsonrpc|restrpc|xmlrpc>
=item packages => [ $package_name, ... ]
=item endpoint => '/endpoint_for_dispatch_tabledispatch_table'
=back
=head3 Responses
A (partial) dispatch-table.
=head1 COPYRIGHT
(c) MMXV - Abe Timmerman <abeltje@cpan.org>
lib/Dancer/RPCPlugin/DispatchMethodList.pm view on Meta::CPAN
Dancer::RPCPlugin::DispatchMethodList - Class for maintaining a global methodlist.
=head1 SYNOPSIS
use Dancer::RPCPlugin::DispatchMethodList;
my $methods = Dancer::RPCPlugin::DispatchMethodList->new();
$methods->set_partial(
protocol => <jsonrpc|restrpc|xmlrpc>,
endpoint => </configured>,
methods => [ @method_names ],
);
# ....
my $method_list = $methods->list_methods(protocol => <any|jsonrpc|restrpc|xmlrpc>);
=head1 DESCRIPTION
This class implements a singleton that can hold the collection of all method names.
lib/Dancer/RPCPlugin/DispatchMethodList.pm view on Meta::CPAN
=head2 $dml->set_partial(%parameters)
=head3 Parameters
Named, list:
=over
=item protocol => <jsonrpc|restrpc|xmlrpc> (required)
=item endpoint => $endpoint (required)
=item methods => \@method_list
=back
=head3 Responses
$self
=cut
sub set_partial {
my $self = shift;
my $pn_re = Dancer::RPCPlugin::PluginNames->new->regex;
my %args = validation_for(
params => {
protocol => {type => StrMatch[ qr/^$pn_re$/ ], optional => 0},
endpoint => {type => StrMatch[ qr/^.*$/] , optional => 0},
methods => {type => ArrayRef},
},
)->(@_);
$self->{protocols}{$args{protocol}}{$args{endpoint}} = $args{methods};
return $self;
}
=head2 list_methods(@parameters)
Method that returns information about the dispatch-table.
=head3 Parameters
Positional, list
lib/Dancer/RPCPlugin/DispatchMethodList.pm view on Meta::CPAN
=item 1. $protocol => undef || <any|jsonrpc|restrpc|xmlrpc> (optional)
=back
=head3 Responses
In case of no C<$protocol>:
{
xmlrpc => {
$endpoint1 => [ list ],
$endpoint2 => [ list ],
},
jsonrpc => {
$endpoint1 => [ list ],
$endpoint2 => [ list ],
},
}
In case of specified C<$protocol>:
{
$endpoint1 => [ list ],
$endpoint2 => [ list ],
}
=cut
sub list_methods {
my $self;
if (blessed($_[0])) {
$self = shift;
}
else {
t/010-dispatch-from-config.t view on Meta::CPAN
use t::Test::abeltje;
use Dancer::Test;
use Dancer::RPCPlugin::DispatchFromConfig;
use Dancer::RPCPlugin::DispatchItem;
{
my $dispatch = dispatch_table_from_config(
plugin => 'xmlrpc',
endpoint => '/xmlrpc',
config => {
'/xmlrpc' => {
'TestProject::SystemCalls' => {
'system.ping' => 'do_ping',
'system.version' => 'do_version',
}
}
}
);
is_deeply(
t/010-dispatch-from-config.t view on Meta::CPAN
package => 'TestProject::SystemCalls',
),
},
"Dispatch from YAML-config"
);
like(
exception {
dispatch_table_from_config(
plugin => 'xmlrpc',
endpoint => '/xmlrpc',
config => {
'/xmlrpc' => {
'TestProject::SystemCalls' => {
'system.nonexistent' => 'nonexistent',
}
}
},
);
},
qr/Handler not found for system.nonexistent: TestProject::SystemCalls::nonexistent doesn't seem to exist/,
t/015-dispatch-from-pod.t view on Meta::CPAN
use Dancer::RPCPlugin::DispatchFromPod;
use Dancer::RPCPlugin::DispatchItem;
{
my $dispatch = dispatch_table_from_pod(
plugin => 'jsonrpc',
packages => [qw/
TestProject::ApiCalls
/],
endpoint => '/testing',
);
is_deeply(
$dispatch,
{
'api.uppercase' => dispatch_item(
code => TestProject::ApiCalls->can('do_uppercase'),
package => 'TestProject::ApiCalls',
),
},
"Dispatch table from POD"
);
like(
exception {
dispatch_table_from_pod(
plugin => 'jsonrpc',
packages => [qw/
TestProject::Bogus
/],
endpoint => '/testing',
)
},
qr/Handler not found for bogus.nonexistent: TestProject::Bogus::nonexistent doesn't seem to exist/,
"Setting a non-existent dispatch target throws an exception"
);
}
{
my $xmlrpc = dispatch_table_from_pod(
plugin => 'xmlrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/system',
);
my $system_call = dispatch_item(
package => 'TestProject::MixedEndpoints',
code => TestProject::MixedEndpoints->can('call_for_system'),
);
my $any_call = dispatch_item(
package => 'TestProject::MixedEndpoints',
code => TestProject::MixedEndpoints->can('call_for_all_endpoints'),
);
is_deeply(
$xmlrpc,
{
'system.call' => $system_call,
'any.call' => $any_call,
},
"picked the /system call for xmlrpc"
);
my $jsonrpc = dispatch_table_from_pod(
plugin => 'jsonrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/system',
);
is_deeply(
$jsonrpc,
{
'system_call' => $system_call,
'any_call' => $any_call,
},
"picked the /system call for jsonrpc"
);
my $restrpc = dispatch_table_from_pod(
plugin => 'restrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/system',
);
is_deeply(
$restrpc,
{
'call' => $system_call,
'any-call' => $any_call,
},
"picked the /system call for restrpc"
);
}
{
my $xmlrpc = dispatch_table_from_pod(
plugin => 'xmlrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/testing',
);
my $testing_call = dispatch_item(
package => 'TestProject::MixedEndpoints',
code => TestProject::MixedEndpoints->can('call_for_testing'),
);
my $any_call = dispatch_item(
package => 'TestProject::MixedEndpoints',
code => TestProject::MixedEndpoints->can('call_for_all_endpoints'),
);
is_deeply(
$xmlrpc,
{
'testing.call' => $testing_call,
'any.call' => $any_call,
},
"picked the /testing call for xmlrpc"
);
my $jsonrpc = dispatch_table_from_pod(
plugin => 'jsonrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/testing',
);
is_deeply(
$jsonrpc,
{
'testing_call' => $testing_call,
'any_call' => $any_call,
},
"picked the /testing call for jsonrpc"
);
my $restrpc = dispatch_table_from_pod(
plugin => 'restrpc',
packages => [ 'TestProject::MixedEndpoints' ],
endpoint => '/testing',
);
is_deeply(
$restrpc,
{
'call' => $testing_call,
'any-call' => $any_call,
},
"picked the /testing call for restrpc"
);
}
t/030-dispatchmethodlist.t view on Meta::CPAN
use t::Test::abeltje;
use Dancer::RPCPlugin::DispatchMethodList;
{
my $l = Dancer::RPCPlugin::DispatchMethodList->new();
isa_ok($l, 'Dancer::RPCPlugin::DispatchMethodList');
$l->set_partial(
protocol => 'jsonrpc',
endpoint => '/customer',
methods => [qw/get_user update_user remove_user/],
);
my $jsonrpc = $l->list_methods('jsonrpc');
is_deeply(
$jsonrpc,
{
'/customer' => [qw/get_user update_user remove_user/],
},
"list_methods(jsonrpc)"
t/030-dispatchmethodlist.t view on Meta::CPAN
"list_methods()"
);
}
{ # It's a singleton => the previous values should stick.
my $l = Dancer::RPCPlugin::DispatchMethodList->new();
isa_ok($l, 'Dancer::RPCPlugin::DispatchMethodList');
$l->set_partial(
protocol => 'xmlrpc',
endpoint => '/customer',
methods => [qw/get_user update_user remove_user/],
);
my $xmlrpc = $l->list_methods('xmlrpc');
is_deeply(
$xmlrpc,
{
'/customer' => [qw/get_user update_user remove_user/],
},
"list_methods(xmlrpc)"
t/071-default-route-xmlrpc.t view on Meta::CPAN
use Dancer qw/:syntax !pass !warning/;
use Dancer::Test;
use Dancer::RPCPlugin::DefaultRoute;
use Dancer::Plugin::RPC::XMLRPC;
use RPC::XML;
use RPC::XML::ParserFactory;
$RPC::XML::ENCODING = 'utf-8';
my $ENDPOINT = '/system/code_wrapper';
my $UNKNOWN_ENDPOINT = '/system/code_wrapper/undefined_endpoint';
use MyTest::API;
use MyTest::Client;
my $client = MyTest::Client->new(ping_value => 'pong');
my $dispatch = {
'MyTest::API' => MyTest::API->new(test_client => $client),
};
my $config = {
config => 'config',
t/071-default-route-xmlrpc.t view on Meta::CPAN
'RPC::XMLRPC' => {
$ENDPOINT => {
'MyTest::API' => {
'system_ping' => 'rpc_ping',
'system.exception' => 'rpc_fail',
}
}
}
}
);
set( clients => { test_client => { endpoint => 'somewhere' } });
xmlrpc $ENDPOINT => $config;
note("Without catchall unknown endpoint errors");
{
my $prefix = "Without catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: Known endpoint returns 200 status");
is_deeply(
$response->{content},
[ { result => 'pong' } ],
"$prefix: Known route returns result"
);
$response = _post($UNKNOWN_ENDPOINT);
route_doesnt_exist([POST => $UNKNOWN_ENDPOINT], "$prefix: Unknown route $UNKNOWN_ENDPOINT");
is($response->{status}, 404, "$prefix: unknown endpoint returns 404 status");
$response = _post($ENDPOINT, { method => 'system.pong'} );
is($response->{status}, 404, "$prefix: Unknown method returns 404 status");
}
setup_default_route();
note('With catchall unknown endpoint errors');
{
my $prefix = "With catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: known endpoint returns 200 status");
is_deeply(
$response->{content},
[ { result => 'pong'} ],
"$prefix: Known route returns result"
);
route_exists([POST => $UNKNOWN_ENDPOINT], "$prefix: Known route: $UNKNOWN_ENDPOINT");
$response = _post($UNKNOWN_ENDPOINT);
is($response->{status}, 200, "$prefix: Unknown route returns 200 status");
t/071-default-route-xmlrpc.t view on Meta::CPAN
like(
$response->{content}{faultString},
qr/Method '.*' not found/,
sprintf("RPC::XMLRPC: %s - %s", $prefix, $response->{content}{faultCode}),
);
}
done_testing();
sub _post {
my ($endpoint, $body) = @_;
my $parser = RPC::XML::ParserFactory->new();
$body //= { method => 'system_ping' };
my $request = RPC::XML::request->new($body->{method})->as_string();
my $response = dancer_response(
POST => $endpoint,
{
content_type => 'text/xml',
body => $request,
},
);
if ($response->{status} == 200) {
$response->{content} = $parser->parse($response->{content})->value->value;
}
return $response;
}
t/072-default-route-jsonrpc.t view on Meta::CPAN
#! perl -I. -w
use t::Test::abeltje;
use Dancer qw/!pass !warning/;
use Dancer::Test;
use Dancer::RPCPlugin::DefaultRoute;
use Dancer::Plugin::RPC::JSONRPC;
my $ENDPOINT = '/system/code_wrapper';
my $UNKNOWN_ENDPOINT = '/system/code_wrapper/undefined_endpoint';
use MyTest::API;
use MyTest::Client;
my $client = MyTest::Client->new(ping_value => 'pong');
my $dispatch = {
'MyTest::API' => MyTest::API->new(test_client => $client),
};
my $config = {
config => 'config',
t/072-default-route-jsonrpc.t view on Meta::CPAN
'RPC::JSONRPC' => {
$ENDPOINT => {
'MyTest::API' => {
'system_ping' => 'rpc_ping',
'system.exception' => 'rpc_fail',
}
}
}
}
);
set( clients => { test_client => { endpoint => 'somewhere' } });
jsonrpc $ENDPOINT => $config;
note("Without catchall unknown endpoint errors");
{
my $prefix = "Without catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: Known endpoint returns 200 status");
is_deeply(
$response->{content}{result},
[ { result => 'pong' } ],
"$prefix: Known route returns result"
);
$response = _post($UNKNOWN_ENDPOINT);
route_doesnt_exist(
[POST => $UNKNOWN_ENDPOINT],
"$prefix: Unknown route $UNKNOWN_ENDPOINT"
);
is($response->{status}, 404, "$prefix: unknown endpoint returns 404 status");
$response = _post(
$ENDPOINT,
{ jsonrpc => "2.0", id => 4242, method => 'system_pong'}
);
is($response->{status}, 200, "$prefix: Unknown method returns 200 status");
is(
$response->{content}{error}{code},
-32601,
"$prefix: Unknown method returns -32601 code"
);
}
setup_default_route();
note('With catchall unknown endpoint errors');
{
my $prefix = "With catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: known endpoint returns 200 status");
is_deeply(
$response->{content}{result},
[ { result => 'pong'} ],
"$prefix: Known route returns result"
);
route_exists([POST => $UNKNOWN_ENDPOINT], "$prefix: Known route: $UNKNOWN_ENDPOINT");
$response = _post($UNKNOWN_ENDPOINT);
is($response->{status}, 200, "$prefix: Unknown route returns 200 status");
t/072-default-route-jsonrpc.t view on Meta::CPAN
like(
$response->{content}{error}{message},
qr/Method '.*' not found/,
sprintf("RPC::JSONRPC: %s - %s", $prefix, $response->{content}{error}{message}),
);
}
done_testing();
sub _post {
my ($endpoint, $body) = @_;
$body //= { jsonrpc => "2.0", id => "42", method => 'system_ping' };
my $request = to_json($body);
my $response = dancer_response(
POST => $endpoint,
{
content_type => 'application/json',
body => $request,
}
);
if ($response->{headers}{'content-type'} eq 'application/json') {
$response->{content} = from_json($response->{content})
}
return $response;
t/073-default-route-restrpc.t view on Meta::CPAN
#! perl -I. -w
use t::Test::abeltje;
use Dancer qw/!pass !warning/;
use Dancer::RPCPlugin::DefaultRoute;
use Dancer::Plugin::RPC::RESTRPC;
use Dancer::Test;
my $ENDPOINT = '/system/code_wrapper';
my $UNKNOWN_ENDPOINT = '/system/code_wrapper/undefined_endpoint';
use MyTest::API;
use MyTest::Client;
my $client = MyTest::Client->new(ping_value => 'pong');
my $dispatch = {
'MyTest::API' => MyTest::API->new(test_client => $client),
};
my $config = {
t/073-default-route-restrpc.t view on Meta::CPAN
'RPC::RESTRPC' => {
$ENDPOINT => {
'MyTest::API' => {
'system_ping' => 'rpc_ping',
'system.exception' => 'rpc_fail',
}
}
}
}
);
set( clients => { test_client => { endpoint => 'somewhere' } });
restrpc $ENDPOINT => $config;
note("Without catchall unknown endpoint errors");
{
my $prefix = "Without catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: Known endpoint returns 200 status");
is_deeply(
$response->{content},
[ { result => 'pong' } ],
"$prefix: Known route returns result"
);
my $url = $UNKNOWN_ENDPOINT.'/system_ping';
$response = _post($UNKNOWN_ENDPOINT);
route_doesnt_exist([POST => $url], "$prefix: Unknown route $url");
is($response->{status}, 404, "$prefix: unknown endpoint returns 404 status");
$response = _post($ENDPOINT, { method => 'system.pong'} );
$url = $ENDPOINT.'/system_pong';
route_doesnt_exist([POST => $url], "$prefix: Unknown route $url");
is($response->{status}, 404, "$prefix: Unknown method returns 404 status");
}
setup_default_route();
note('With catchall unknown endpoint errors');
{
my $prefix = "With catchall";
my $response = _post($ENDPOINT);
is($response->{status}, 200, "$prefix: known endpoint returns 200 status");
is_deeply(
$response->{content},
[ {result => 'pong'} ],
"$prefix: Known route returns result"
);
my $url = $UNKNOWN_ENDPOINT.'/system_ping';
route_exists([POST => $url], "$prefix: Known route: $url");
$response = _post($UNKNOWN_ENDPOINT);
is($response->{status}, 200, "$prefix: Unknown route returns 200 status");
t/073-default-route-restrpc.t view on Meta::CPAN
like(
$error->{message},
qr/Method '.*' not found/,
sprintf("RPC::RESTRPC: %s - %s", $prefix, $error->{message})
);
}
done_testing();
sub _post {
my ($endpoint, $body) = @_;
my $url = sprintf("%s/%s", $endpoint, defined $body ? $body->{method} : 'system_ping');
my $response = dancer_response(
POST => $url,
{
content_type => 'application/json',
body => to_json({}),
}
);
$response->{content} = from_json(delete $response->{content})
if $response->{status} == 200;
t/175-restrpc.t view on Meta::CPAN
{
my $response = dancer_response(
POST => '/rest/system/four_o_four',
{
headers => [
'Content-Type' => 'application/json',
],
}
);
is($response->status, 404, "Check endpoint");
}
{
my $response = dancer_response(
POST => '/rest/system/ping',
{
headers => [
'Content-Type' => 'form',
],
}
t/200-register-xmlrpc.t view on Meta::CPAN
use Dancer::Test;
use RPC::XML;
use RPC::XML::ParserFactory;
my $p = RPC::XML::ParserFactory->new();
{
note("default publish (config)");
set(plugins => {
'RPC::XMLRPC' => {
'/endpoint' => {
'TestProject::SystemCalls' => {
'system.ping' => 'do_ping',
'system.version' => 'do_version',
},
},
}
});
xmlrpc '/endpoint' => { };
route_exists([POST => '/endpoint'], "/endpoint registered");
my $response = dancer_response(
POST => '/endpoint',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new(
'system.ping',
)->as_string,
}
);
t/200-register-xmlrpc.t view on Meta::CPAN
is_deeply(
$result->value,
{ response => 1 },
"system.ping"
);
}
{
note("publish is code that returns the dispatch-table");
xmlrpc '/endpoint2' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'code.ping' => dispatch_item(
code => TestProject::SystemCalls->can('do_ping'),
package => 'TestProject::SystemCalls',
),
};
},
callback => sub { return callback_success(); },
};
route_exists([POST => '/endpoint2'], "/endpoint2 registered");
my $response = dancer_response(
POST => '/endpoint2',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new(
'code.ping',
)->as_string,
}
);
t/200-register-xmlrpc.t view on Meta::CPAN
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{ response => 1 },
"code.ping"
);
}
{
note("callback fails");
xmlrpc '/endpoint_fail' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => TestProject::SystemCalls->can('do_ping'),
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_fail(
error_code => -500,
error_message => "Force callback error",
);
},
};
route_exists([POST => '/endpoint_fail'], "/endpoint_fail registered");
my $response = dancer_response(
POST => '/endpoint_fail',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.ping')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{faultCode => -500, faultString =>"Force callback error"},
"fail.ping"
);
}
{
note("callback dies");
xmlrpc '/endpoint_fail2' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
die "terrible death\n";
},
};
route_exists([POST => '/endpoint_fail2'], "/endpoint_fail2 registered");
my $response = dancer_response(
POST => '/endpoint_fail2',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.ping')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{faultCode => -32500, faultString =>"terrible death\n"},
"fail.ping"
);
}
{
note("code_wrapper dies");
xmlrpc '/endpoint_fail3' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_success();
},
code_wrapper => sub {
die "code_wrapper died\n";
},
};
route_exists([POST => '/endpoint_fail3'], "/endpoint_fail3 registered");
my $response = dancer_response(
POST => '/endpoint_fail3',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.ping')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{faultCode => -32500, faultString =>"code_wrapper died\n"},
"fail.ping (code_wrapper)"
);
}
{
note("callback returns unknown object");
xmlrpc '/endpoint_fail4' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
bless {easter => 'egg'}, 'SomeRandomClass';
},
code_wrapper => sub {
return 'pang';
},
};
route_exists([POST => '/endpoint_fail4'], "/endpoint_fail4 registered");
my $response = dancer_response(
POST => '/endpoint_fail4',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.ping')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
t/200-register-xmlrpc.t view on Meta::CPAN
{
faultCode => -32500,
faultString => "Internal error: 'callback_result' wrong class SomeRandomClass"
},
"fail.ping (callback wrong class)"
) or diag(explain($result->value));
}
{
note("code_wrapper returns unknown object");
xmlrpc '/endpoint_fail5' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_success();
},
code_wrapper => sub {
bless {easter => 'egg'}, 'SomeRandomClass';
},
};
route_exists([POST => '/endpoint_fail5'], "/endpoint_fail5 registered");
my $response = dancer_response(
POST => '/endpoint_fail5',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.ping')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{easter => 'egg'},
"fail.ping (code_wrapper object)"
) or diag(explain($result->value));
}
{
note("rpc-call fails");
xmlrpc '/endpoint_error' => {
publish => sub {
return {
'fail.error' => dispatch_item(
code => sub { die "Example error code\n" },
package => __PACKAGE__,
),
};
},
};
route_exists([POST => '/endpoint_error'], "/endpoint_error registered");
my $response = dancer_response(
POST => '/endpoint_error',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.error')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
is_deeply(
$result->value,
{faultCode => -32500, faultString =>"Example error code\n"},
"fail.error"
);
}
{
note("return an error_response()");
xmlrpc '/endpoint_fault' => {
publish => sub {
return {
'fail.error' => dispatch_item(
code => sub { error_response(error_code => 42, error_message => "Boo!") },
package => __PACKAGE__,
),
};
},
};
route_exists([POST => '/endpoint_fault'], "/endpoint_fault registered");
my $response = dancer_response(
POST => '/endpoint_fault',
{
headers => [
'Content-Type' => 'text/xml',
],
body => RPC::XML::request->new('fail.error')->as_string,
}
);
is($response->status, 200, "Errors produce HTTP 200 OK");
my $result = $p->parse($response->{content})->value;
t/250-register-jsonrpc.t view on Meta::CPAN
use Dancer::RPCPlugin::CallbackResult;
use Dancer::RPCPlugin::DispatchItem;
use Dancer::RPCPlugin::ErrorResponse;
use Dancer::Test;
{
note("default publish => 'pod' ; Batch-mode");
set(plugins => {
'RPC::JSONRPC' => {
'/endpoint' => {
'TestProject::SystemCalls' => {
'system.ping' => 'do_ping',
'system.version' => 'do_version',
},
},
}
});
jsonrpc '/endpoint' => { };
route_exists([POST => '/endpoint'], "/endpoint registered");
my $response = dancer_response(
POST => '/endpoint',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json([
{
jsonrpc => '2.0',
method => 'system.ping',
id => 42,
},
t/250-register-jsonrpc.t view on Meta::CPAN
[
$ping,
{software_version => '1.0'},
],
"system.ping"
) or diag(explain(\@results));
}
{
note("publish is code that returns the dispatch-table");
jsonrpc '/endpoint2' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'code.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub { return callback_success() },
};
route_exists([POST => '/endpoint2'], "/endpoint2 registered");
my $response = dancer_response(
POST => '/endpoint2',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'code.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
is_deeply(
from_json($response->{content})->{result},
$ping,
"code.ping"
);
}
{
note("callback fails");
jsonrpc '/endpoint_fail' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_fail(
error_code => -500,
error_message => "Force callback error",
);
},
};
route_exists([POST => '/endpoint_fail'], "/endpoint_fail registered");
my $response = dancer_response(
POST => '/endpoint_fail',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
is_deeply(
from_json($response->{content})->{error},
{code => -500, message =>"Force callback error"},
"fail.ping"
) or diag($response->{content});
}
{
note("callback dies");
jsonrpc '/endpoint_fail2' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
die "terrible death\n";
},
};
route_exists([POST => '/endpoint_fail2'], "/endpoint_fail registered");
my $response = dancer_response(
POST => '/endpoint_fail2',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
is_deeply(
from_json($response->{content})->{error},
{code => -32500, message =>"terrible death\n"},
"fail.ping"
);
}
{
note("code_wrapper dies");
jsonrpc '/endpoint_fail3' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_success();
},
code_wrapper => sub {
die "code_wrapper died\n";
},
};
route_exists([POST => '/endpoint_fail3'], "/endpoint_fail3 registered");
my $response = dancer_response(
POST => '/endpoint_fail3',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
my $error = from_json($response->{content})->{error};
is_deeply(
$error,
{code => -32500, message =>"code_wrapper died\n"},
"fail.ping (code_wrapper died)"
) or diag(explain($error));
}
{
note("callback returns unknown object");
jsonrpc '/endpoint_fail4' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
bless {easter => 'egg'}, 'SomeRandomClass';
},
code_wrapper => sub {
return 'pang';
},
};
route_exists([POST => '/endpoint_fail4'], "/endpoint_fail4 registered");
my $response = dancer_response(
POST => '/endpoint_fail4',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
{
code => -32603,
message => "Internal error: 'callback_result' wrong class SomeRandomClass",
},
"fail.ping (callback wrong class)"
) or diag(explain($error));
}
{
note("code_wrapper returns unknown object");
jsonrpc '/endpoint_fail5' => {
publish => sub {
eval { require TestProject::SystemCalls; };
error("Cannot load: $@") if $@;
return {
'fail.ping' => dispatch_item(
code => \&TestProject::SystemCalls::do_ping,
package => 'TestProject::SystemCalls',
),
};
},
callback => sub {
return callback_success();
},
code_wrapper => sub {
bless {easter => 'egg'}, 'SomeRandomClass';
},
};
route_exists([POST => '/endpoint_fail5'], "/endpoint_fail5 registered");
my $response = dancer_response(
POST => '/endpoint_fail5',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.ping',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
is_deeply(
$error,
{easter => 'egg'},
"fail.ping (code_wrapper object)"
) or diag(explain($error));
}
{
note("rpc-call fails");
jsonrpc '/endpoint_error' => {
publish => sub {
return {
'fail.error' => dispatch_item(
code => sub { die "Example error code\n" },
package => __PACKAGE__,
),
};
},
};
route_exists([POST => '/endpoint_error'], "/endpoint_error registered");
my $response = dancer_response(
POST => '/endpoint_error',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.error',
id => 42,
}
t/250-register-jsonrpc.t view on Meta::CPAN
is_deeply(
from_json($response->{content})->{error},
{code => -32500, message =>"Example error code\n"},
"fail.error"
);
}
{
note("return an error_response()");
jsonrpc '/endpoint_fault' => {
publish => sub {
return {
'fail.error' => dispatch_item(
code => sub { error_response(error_code => 42, error_message => "Boo!") },
package => __PACKAGE__,
),
};
},
};
route_exists([POST => '/endpoint_fault'], "/endpoint_fault registered");
my $response = dancer_response(
POST => '/endpoint_fault',
{
headers => [
'Content-Type' => 'application/json',
],
body => to_json(
{
jsonrpc => '2.0',
method => 'fail.error',
id => 42,
}
t/lib/TestProject/MixedEndpoints.pm view on Meta::CPAN
package TestProject::MixedEndpoints;
use warnings;
use strict;
=head1 DESCRIPTION
Package with calls for diffent endpoints.
=head2 call_for_system
=for xmlrpc system.call call_for_system /system
=for jsonrpc system_call call_for_system /system
=for restrpc call call_for_system /system
=cut
sub call_for_system { return {endpoint => '/system'} }
=head2 call_for_testing
=for xmlrpc testing.call call_for_testing /testing
=for jsonrpc testing_call call_for_testing /testing
=for restrpc call call_for_testing /testing
=cut
sub call_for_testing { return {endpoint => '/testing'} }
=head2 call_for_all_endpoints
=for xmlrpc any.call call_for_all_endpoints
=for jsonrpc any_call call_for_all_endpoints
=for restrpc any-call call_for_all_endpoints
=cut
sub call_for_all_endpoints { return {endpoint => '*'} }
1;