From Code to Community: Sponsoring The Perl and Raku Conference 2025 Learn more

ABELTJE / Dancer-Plugin-RPC-1.11 / t / 071-default-route-xmlrpc.t 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141

              
#! perl -I. -w
use t::Test::abeltje;
BEGIN {
    $ENV{DANCER_ENVIRONMENT} = 'test';
    $ENV{DANCER_APPDIR}      = '.';
}
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',
    code_wrapper => sub {
        my ($code, $package, $method_name, @arguments) = @_;
        my $result = eval {
        my $instance = $dispatch->{$package};
            $instance->$code(@arguments);
        };
        if (my $error = $@) {
            error("[code_wrapper] ($package\->$method_name) ", $error);
            if (blessed($error) and $error->does('MyTest::Exception')) {
                # The plugin will send a proper error-response for the protocol
                die $error->as_string;
            }
            die $error;
        };
        return  [ $result ];
    },
};
set(
    plugins => {
        '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");
    is_deeply(
        $response->{content},
        {
            faultCode   => -32601,
            faultString => "Method 'system_ping' not found",
        },
        "$prefix: Unknown route returns -32601 error"
    ) or diag(explain($response));
    route_exists([POST => $UNKNOWN_ENDPOINT], "$prefix: Known route $UNKNOWN_ENDPOINT");
    $response = _post($ENDPOINT, { method => 'system.pong'} );
    is($response->{status}, 200, "$prefix: Unknown method returns 200 status");
    is($response->{content}{faultCode}, -32601, "$prefix: Unknown method returns -32601 code");
    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;
}