view release on metacpan or  search on metacpan

example/bin/do-rpc  view on Meta::CPAN

        use RPC::XML;
        use RPC::XML::ParserFactory;
        use Scalar::Util 'blessed';
        use Data::Dumper;

        has parser => (
            is  => 'lazy',
            isa => sub { blessed($_[0]) eq 'RPC::XML::Parser::XMLParser' },
        );

        sub _build_parser {
            my $self = shift;
            return RPC::XML::ParserFactory->new();
        }

        sub call {
            my $self = shift;
            my ($method_name, $data) = @_;

            my $request = RPC::XML::request->new($method_name => $data)->as_string();
            $self->log_debug($request);
            my $response = $self->client->request(
                POST => $self->base_uri,
                {
                    headers => {
                        'Content-Type'   => 'text/xml',
                        'Content-Length' => length($request),
                    },
                    content => $request,
                }
            );
            $self->log_trace(Dumper($response));

            my $return;
            if ( $response->{success} ) {
                my $content = $response->{content};
                $return = $self->parser->parse($response->{content})->value->value;
                $self->log_debug(Dumper($data));
            }
            else {
                $return = join(" ", @{$response}{qw/status reason/});
            }
            return $return;
        }

        1;
    }

    package RESTRPCClient {
        use Moo;
        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));
            my $result;
            if ($response->{success}) {
                $result = decode_json($response->{content});
                if (exists $result->{error}) {
                    return $result->{error};
                }
                else {
                    return $result;
                }
            }
            else {
                $result = join(" ", @{$response}{qw/status reason/});
            }
            return $result;
        }
    }
};

=head1 NAME

do-rpc - Doe een rpc-call.

=head1 SYNOPSIS

    do-rpc -t xmlrpc -u <url> -c <methodName> arguments...

=head1 OPTIONS

    --type|-t   <jsonrpc|xmlrpc|restrpc>   (verstek 'jsonrpc')
    --url|-u    <base_url>                 De base_url for
    --call|-c   <methodName>
    --method|-m <GET|POST|PUT|DELETE>      (verstek 'POST')
    --json <jsonstring>

    --debug
    --help

    do-xmlrpc => do-rpc -t xmlrpc "$@"
    do-json   => do-rpc -t restrpc "$@"

=head1 STUFF

(c) MMXV - Abe Timmerman <abeltje@cpan.org>

=cut