Perl JSON :: RPC :: Client, использующий LWP :: Agent - PullRequest
Новая
       17

Perl JSON :: RPC :: Client, использующий LWP :: Agent

4 голосов
/ 03 января 2012

Мне выдвинули требования не использовать JSON :: RPC :: Client, вместо этого использовать LWP для выполнения вызовов.

Вот мой код:

Сервер: 

#!/usr/bin/perl

use strict;
use lib ".";

use ServerLib;

use JSON::RPC::Server::Daemon;

die "Do Not run as Root\n" if($< == 0);
print "Starting Daemon\n";
my $daemon =  JSON::RPC::Server::Daemon->new(LocalPort => 8000);
$daemon->dispatch({'/jsonrpc/API' => 'ServerLib'})->handle();
exit;

Модуль: 

package ServerLib;

use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
use JSON;
use Data::Dumper;
use Sys::Hostname;
use Net::RabbitMQ;
use YAML qw( LoadFile );
use strict;

$| = 1;
my $VERSION = 0.2.0;

sub echo : Public(message:string) {
    my ($s, $obj) = @_;
    my $message = $obj->{'message'};
    print "got message => $message\n";
    print "returning: $message\n";
    my $object = { message => $message,
                   foobar => "garbage" };

    return $object;
 }
package ServerLib::system;

sub describe {
    {
        sdversion => "0.1",
        name      => 'ServerLib',
    };
}

1;

Рабочий клиент: 

#!/usr/bin/perl

use strict;

use JSON::RPC::Client;
use Data::Dumper;
my $client = new JSON::RPC::Client;

my $uri = 'http://localhost:8000/jsonrpc/API';
my $obj = {
    method  => 'echo', # or 'MyApp.sum'
    params  => ["my message"],
};

my $res = $client->call( $uri, $obj );

if($res){
   if ($res->is_error) {
       print "Error : ", $res->error_message;
   }
    else {
       print Dumper($res->result);
   }
 }
 else {
    print $client->status_line;
 }

Неработающий клиент: 

#!/usr/bin/perl -w

use strict;
use JSON;
use LWP::Simple;
use Data::Dumper;

my $actionurl = "http://localhost:8000/jsonrpc/API";

my $ua = LWP::UserAgent->new();
$ua->agent("JSONClient/0.1");

my $object = { method => "echo",
           params => [@ARGV ] };

my $json = to_json($object);
print "$json\n";
my $req = HTTP::Request->new(POST => $actionurl);
$req->content_type('application/json');
$req->content($json);

my $res = $ua->request($req);
if ($res->is_success)
{
    print "Succeeded:\n" . Dumper($res->dump);
    print "DUmp: ". $res->dump;
    my $result = to_json($res->content);
 }
  else
      {
        print "Failed\n";
 }

Я вижу процесс сервера для обоих клиентов, но у второго клиента нет данных, возвращаемых ему.

DUmp: HTTP/1.1 200 OK
Connection: close
Date: Tue, 03 Jan 2012 18:24:24 GMT
Server: libwww-perl-daemon/5.827
Content-Type: application/json; charset=UTF-8
Client-Date: Tue, 03 Jan 2012 18:24:24 GMT
Client-Peer: 127.0.0.1:8000
Client-Response-Num: 1

(no content)

Кто-нибудь видит, чего мне не хватает?Это должно быть довольно просто, но по какой-то причине я не могу найти строку ответа, как RPC :: Client видит.

Ответы [ 2 ]

2 голосов
/ 04 января 2012

Это было сложно.Один из моих коллег нашел его, а он не в Stackoverflow, поэтому я опубликую исправление.

Это: 

my $object = { method => "echo",
       params => [@ARGV ] };

Необходимая версия => "1.1", добавлено к ней: 

my $object = { method => "echo",
               params => [@ARGV],
               version => "1.1",};

Не уверен, почему это важно, но как только это былодобавил, что это работает как шарм.

0 голосов
/ 04 января 2012
  • Что выводит «Не работающий клиент»?"Успешно" или "Не удалось?"
  • Какие аргументы вы передаете?(@ARGV)
  • Какой вывод вы получите, если сбросить объект запроса?
  • Какой вывод получите, если сбросить объект ответа?
...