Catalyst-Plugin-Server-JSONRPC

 view release on metacpan or  search on metacpan

bin/jsonrpc_client  view on Meta::CPAN

#!/usr/bin/perl --

use strict;
use Data::Dumper;
use Getopt::Std;
use vars qw[%opts];

use JSON::RPC::Common::Procedure::Call;
use JSON;
use HTTP::Request;
use LWP::UserAgent;

getopts( 'hedu:m:p:', \%opts );

$opts{'p'} ||= '3000';
$opts{'v'} ||= '1.0';
$opts{'u'} ||= 'http://127.0.0.1:'.$opts{p}.'/rpc';
$opts{'m'} ||= 'echo.echo';
$opts{'h'} and die usage();

bin/jsonrpc_client  view on Meta::CPAN

my $req = JSON::RPC::Common::Procedure::Call->inflate({
        version=>$opts{'v'},
		method => $opts{'m'},
		id     => 1,
		params => \@args,
});

my $req_string = to_json($req->deflate);
print $req_string, $/ if $opts{'d'};

my $req = HTTP::Request->new( POST => $opts{'u'} );
$req->header( 'Content-Length'  => length($req_string) );
$req->header( 'Content-Type'    => 'application/json' );
$req->content( $req_string );
my $ua = LWP::UserAgent->new;
my $res = $ua->request( $req );

unless ($res->is_success) {
    print "\n\n-----------------Error-----------\n";
    print $res->status_line."\n";
    exit -1;

lib/JSON/RPC/Common/Marshal/Catalyst.pm  view on Meta::CPAN

		my $call = $m->request_to_call($c->req);
		my $res = $call->call($self);
		$m->write_result_to_response($c->res);
	}

=head1 DESCRIPTION

This object provides marshalling routines to convert L<Catalyst::Request> 
to L<JSON::RPC::Common:Call> object.

Use  L<JSON::RPC::Common::Marshal::Catalyst> to work with L<HTTP::Request>

=head1 METHODS

=over 4

=item post_request_to_call $http_request

Convert an L<Catalyst::Request> to a L<JSON::RPC::Common::Procedure::Call>. Overriden method only differ from parent that use $request->body instead of $request->content;

=back

t/002_live.t  view on Meta::CPAN

    
    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use HTTP::Request;
use Data::Dumper;


my %RpcArgs     = ( 1 => "b" );
#my %RpcRv       = ( auto => 1, begin => 1, end => 1, input => \%RpcArgs );
my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
my $EntryPoint  = 'http://localhost/rpc';
my $Prefix      = 'rpc.functions.';
my %Methods     = (
    # method name       # rv

t/002_live.t  view on Meta::CPAN



while ( my($meth,$rv) = each %Methods ) {

    use JSON::RPC::Common::Marshal::Text;
    use JSON;
    my $m = JSON::RPC::Common::Marshal::Text->new;
    my $call = {version=>'1.1', method=>$Prefix . $meth, params=>\%RpcArgs, id=>1};
    my $str = JSON::to_json($m->json_to_call(JSON::to_json($call))->deflate());

    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($str) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $str );
    my $res = request( $req );
    
    ok( $res,                   "Got response on '$meth'" );
    ok( $res->is_success,       "   Response successfull 2XX" );
    is( $res->code, 200,        "   Reponse code 200" );
    
    my $data = JSON::from_json( $res->content );

t/003_Settings.t  view on Meta::CPAN

    
    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use HTTP::Request;
use Data::Dumper;


my $EntryPoint  = 'http://localhost/rpc';
my $Method      = 'rpc.settings.test';


run_test( '1.1', { input => { 1 => "b" } } );  # a single hashref
run_test( '1.0', [1..9] );                       # a list of args

sub run_test {
    my ($ver, $arg) = @_;

    use JSON::RPC::Common::Marshal::Text;
    use JSON;
    my $m = JSON::RPC::Common::Marshal::Text->new;
    my $call = {version=>$ver, method=>$Method, params=>$arg, id=>1};
    my $str = JSON::to_json($m->json_to_call(JSON::to_json($call))->deflate());

    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($str) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $str );
    my $res = request( $req );
    
    ok( $res,                       "Got response on '$Method'" );
    ok( $res->is_success,           "   Response successfull 2XX" );
    is( $res->code, 200,            "   Reponse code 200" );
    
    my $data = JSON::from_json( $res->content )->{result};

t/004_Attributes.t  view on Meta::CPAN

    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';
use JSON;

#use HTTP::Request;
use Data::Dumper;


my %Setup       = (
        'webonly'   => {
            web => '/web/only',
            rpc => 'web.only',
            valid => [ 'web' ],
            },
        'rpconly'   => {

t/004_Attributes.t  view on Meta::CPAN



### Some defaults
sub shoot {
    my ($meth, $content) = @_;
    if (!$content) {
        my $call = {version=>'1.1', method=>$RpcPrefix . $meth, params=>\%RpcArgs, id=>1};
        $content = JSON::to_json($call);
    }

    my $req = HTTP::Request->new( POST => $RpcEntryPoint );
    $req->header( 'Content-Length'  => length($content) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $content );
    my $res = request( $req );
}

while ( my($action, $data) = each %Setup ) {
    ### Check RPC
    {
        my $req = shoot($data->{rpc});

t/005_listMethods.t  view on Meta::CPAN

    
    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use HTTP::Request;
use Data::Dumper;


my @result =  (
   'rpc.also',
   'rpc.functions.echo_fault',
   'rpc.settings.test',
   'rpc.errors.remoteonly',
   'rpc.only',
   'rpc.functions.echo_plain',

t/005_listMethods.t  view on Meta::CPAN


my $EntryPoint  = 'http://localhost/rpc';


use JSON::RPC::Common::Marshal::Text;
use JSON;
my $m = JSON::RPC::Common::Marshal::Text->new;
my $call = {version=>'1.0', method=>'system.listMethods', params=>[], id=>1};
my $str = JSON::to_json($m->json_to_call(JSON::to_json($call))->deflate());

my $req = HTTP::Request->new( POST => $EntryPoint );
$req->header( 'Content-Length'  => length($str) );
$req->header( 'Content-Type'    => 'application/json' );
$req->content( $str );
my $res = request( $req );

ok( $res,                   "Got response ");
ok( $res->is_success,       "   Response successfull 2XX" );
is( $res->code, 200,        "   Reponse code 200" );

my $data = JSON::from_json( $res->content );

t/020_Dispatch_live.t  view on Meta::CPAN

    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use JSON;
use HTTP::Request;
use Data::Dumper;

my $EntryPoint  = 'http://localhost/rpc';
my @Methods     = qw[a 1];
    

# init -- mention var twice due to warnings;
for my $meth ( @Methods ) {

    my $call = {version=>'1.1', method=>$meth, params=>[], id=>1};
    my $str = JSON::to_json($call);


    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($str) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $str );
    my $res = request( $req );
    
    ok( $res,                   "Got response on '$meth'" );
    ok( $res->is_success,       "   Response successfull 2XX" );
    is( $res->code, 200,        "   Reponse code 200" );
    
    my $data = JSON::from_json( $res->content )->{result};

t/030_Error_live.t  view on Meta::CPAN

    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use JSON;
use HTTP::Request;
use Data::Dumper;

### Change config to show errors
TestApp->server->jsonrpc->config->show_errors(1);

my %RpcArgs     = ( 1 => "b" );
#my %RpcRv       = ( auto => 1, begin => 1, end => 1, input => \%RpcArgs );
my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
my $EntryPoint  = 'http://localhost/rpc';
my $Prefix      = 'rpc.errors.';

t/030_Error_live.t  view on Meta::CPAN



### Some defaults
sub shoot {
    my ($meth, $content) = @_;
    if (!$content) {
        my $call = {version=>'1.1', method=>$meth, params=>\%RpcArgs, id=>1};
        $content = JSON::to_json($call);
    }

    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($content) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $content );
    my $res = request( $req );
}

while ( my($meth,$data) = each %Methods ) {

    my $res = shoot($meth);

t/040_faultcode.t  view on Meta::CPAN

    chdir 't' if -d 't';
    use lib qw[../lib inc];

    require 'local_request.pl';
}

use Test::More  'no_plan';
use Catalyst::Test 'TestApp';

use JSON;
use HTTP::Request;
use Data::Dumper;

my %RpcArgs     = ( 1 => "b" );
my %RpcRv       = ( auto => 1, begin => 1, end => 1 );
my $EntryPoint  = 'http://localhost/rpc';
my $Prefix      = 'rpc.functions.';
my %Methods     = (
    'echo_fault'        => [ 101, 'echo_fault' ]
);

while ( my($meth,$rv) = each %Methods ) {

    my $call = {version=>'1.1', method=>$Prefix . $meth, params=>\%RpcArgs, id=>1};
    my $str = JSON::to_json($call);

    my $req = HTTP::Request->new( POST => $EntryPoint );
    $req->header( 'Content-Length'  => length($str) );
    $req->header( 'Content-Type'    => 'application/json' );
    $req->content( $str );
    my $res = request( $req );

    ok( $res,                   "Got response on '$meth'" );
    ok( $res->is_success,       "   Response successfull 2XX" );
    is( $res->code, 200,        "   Reponse code 200" );

    my $data = JSON::from_json( $res->content )->{error};

t/inc/local_request.pl  view on Meta::CPAN

BEGIN {
    no warnings 'redefine';
    require Catalyst::Test;

    *Catalyst::Test::local_request = sub {
        my ( $class, $request ) = @_;
        use Data::Dumper;

        require HTTP::Request::AsCGI;
        require Catalyst::Utils;
        $request = ref($request) ? $request : Catalyst::Utils::request($request);
        my $cgi = HTTP::Request::AsCGI->new( $request, %ENV )->setup;

        $class->handle_request;

        return $cgi->restore->response;
    };
}

1;



( run in 1.111 second using v1.01-cache-2.11-cpan-de7293f3b23 )