Группа :: Разработка/Perl
Пакет: perl-JSON-RPC
навигация по пакетам
Главная Изменения Спек Патчи Исходники Загрузить Gear Bugs and FR Repocop
JSON-RPC-0.98/ 0000755 0000000 0000000 00000000000 11472557432 0012655 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/Changes 0000644 0000000 0000000 00000004425 11472557432 0014155 0 ustar 00root root 0000000 0000000 Revision history for Perl extension JSON::RPC.
###### In the next large version up ######################################
* JSON::RPC::Server::Apache will be renamed to JSON::RPC::Server::Apache2
and split into another distribution.
* JSON::RPC::Server::Apache really supports apache 1.3x
and the maintainer will be changed.
##########################################################################
0.96 Mon Feb 25 11:06:25 2008
- JSON::RPC::Server::FastCGI was split into the independent distribution.
the new maintainer is Faiz Kazi.
- JSON::RPC::Server::Apache was renamed to JSON::RPC::Server::Apache2
it will split into another distribution.
- added and updated docs.
0.95 Fri Feb 15 16:01:04 2008
- sample codes were indexed...!
fixed package for avoiding the indexer.
0.94 Fri Feb 15 15:16:32 2008
- no change but examples was forgotten.
0.93 Fri Feb 15 14:46:17 2008
- added example codes.
- now AUTOLOAD method after prepare() can support built-in methods.
$client -> __VERSION__ ( => $client calls the name 'VERSION' procedure )
- Your application can set subroutines allowable by allowable_procedure().
(Thanks to seagull's suggestion)
- JSON::RPC::Server::Apache config supports 'return_die_message'.
- require LWP::UserAgent 2.001 or later.
0.92 Thu Feb 14 13:12:40 2008
- modified the JSON::RPC::Client prepare mode to check response errors.
(Thanks to Colin Meyer)
- fixed retrieve_json_from_get in JSON::RPC::Server::CGI.
- implemented JSON::RPC::Server::Apache to support the GET method call.
- fixed JSON::RPC::ReturnObject decoding JSON data with utf8 mode.
($client -> call() ->result will return Unicode characters (if contained).)
- added some descriptions to the JSON::RPC::Client pod.
0.91 Wed Dec 19 15:51:53 2007
- JSON::RPC::Client used JSON::PP.
- added create_json_coder() to JSON::RPC::Client.
0.90 Wed Dec 19 13:26:15 2007
- Now default JSON coder is JSON! (1.99 or later)
- added JSON::RPC::Server::FastCGI written by Faiz Kazi, thanks!
- added JSONRPC for guide to this distribution.
- cleaned up JSON::RPC::Server::CGI
- added create_json_coder() to JSON::RPC::Server.
- modified J::R::Server::* as base.pm does not work well in Perl 5.005
0.01 Mon May 21 14:18:33 2007
- original version
JSON-RPC-0.98/MANIFEST 0000644 0000000 0000000 00000000662 11472557432 0014012 0 ustar 00root root 0000000 0000000 Changes
lib/JSON/RPC.pm
lib/JSON/RPC/Client.pm
lib/JSON/RPC/Server.pm
lib/JSON/RPC/Procedure.pm
lib/JSON/RPC/Server/Apache2.pm
lib/JSON/RPC/Server/CGI.pm
lib/JSON/RPC/Server/Daemon.pm
lib/JSONRPC.pm
Makefile.PL
MANIFEST
README
t/00_pod.t
t/01_use.t
t/02_server.t
ex/client.pl
ex/server.cgi
ex/serverd.pl
ex/jsonrpc.conf
ex/MyApp.pm
ex/MyApp/Subclass.pm
META.yml Module meta-data (added by MakeMaker)
JSON-RPC-0.98/META.yml 0000644 0000000 0000000 00000001232 11472557432 0014124 0 ustar 00root root 0000000 0000000 --- #YAML:1.0
name: JSON-RPC
version: 0.96
abstract: Perl implementation of JSON-RPC 1.1 protocol
license: ~
author:
- Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
generated_by: ExtUtils::MakeMaker version 6.42
distribution_type: module
requires:
CGI: 2.92
HTTP::Request: 0
HTTP::Response: 0
JSON: 2
LWP::UserAgent: 2.001
Test::More: 0
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.3.html
version: 1.3
JSON-RPC-0.98/Makefile.PL 0000644 0000000 0000000 00000001414 11472557432 0014627 0 ustar 00root root 0000000 0000000 use 5.00503;
use ExtUtils::MakeMaker;
# See lib/ExtUtils/MakeMaker.pm for details of how to influence
# the contents of the Makefile that is written.
WriteMakefile(
'NAME' => 'JSON::RPC',
'VERSION_FROM' => 'lib/JSON/RPC.pm', # finds $VERSION
'PREREQ_PM' => {
Test::More => 0,
CGI => 2.92,
HTTP::Request => 0,
HTTP::Response => 0,
JSON => 2.0,
LWP::UserAgent => 2.001,
}, # e.g., Module::Name => 1.1
($] >= 5.005 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'lib/JSON/RPC.pm', # retrieve abstract from module
AUTHOR => 'Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>') : ()),
);
JSON-RPC-0.98/README 0000644 0000000 0000000 00000005673 11472557432 0013550 0 ustar 00root root 0000000 0000000 JSON::RPC version 0.96
=================
NAME
JSON::RPC - Perl implementation of JSON-RPC 1.1 protocol
DESCRIPTION
JSON-RPC is a stateless and light-weight remote procedure call (RPC)
protocol for inter-networking applications over HTTP. It uses JSON
as the data format for of all facets of a remote procedure call,
including all application data carried in parameters.
quoted from <http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>.
This module was in JSON package on CPAN before. Now its interfaces was
completely changed.
The old modules - JSONRPC::Transport::HTTP and Apache::JSONRPC are
deprecated. Please try to use JSON::RPC::Server and JSON::RPC::Client
which support both JSON-RPC protocol version 1.1 and 1.0.
EXAMPLES
CGI version.
#--------------------------
# In your application class
package MyApp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
sub echo : Public { # new version style. called by clients
# first argument is JSON::RPC::Server object.
return $_[1];
}
sub sum : Public(a:num, b:num) { # sets value into object member a, b.
my ($s, $obj) = @_;
# return a scalar value or a hashref or an arryaref.
return $obj->{a} + $obj->{b};
}
sub a_private_method : Private {
# ... can't be called by client
}
sub sum_old_style { # old version style. taken as Public
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
#--------------------------
# In your triger script.
use JSON::RPC::Server::CGI;
use MyApp;
# simple
JSON::RPC::Server::CGI->dispatch('MyApp')->handle();
# or
JSON::RPC::Server::CGI->dispatch([qw/MyApp FooBar/])->handle();
# or INFO_PATH version
JSON::RPC::Server::CGI->dispatch({'/Test' => 'MyApp'})->handle();
#--------------------------
# Client
use JSON::RPC::Client;
my $client = new JSON::RPC::Client;
my $uri = 'http://www.example.com/jsonrpc/Test';
my $obj = {
method => 'sum', # or 'MyApp.sum'
params => [10, 20],
};
my $res = $client->call( $uri, $obj )
if($res){
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
# or
$client->prepare($uri, ['sum', 'echo']);
print $client->sum(10, 23);
See to JSON::RPC::Server::CGI, JSON::RPC::Server::Daemon,
JSON::RPC::Server::Apache2 JSON::RPC::Client and JSON::RPC::Procedure.
ABOUT NEW VERSION
supports JSON-RPC protocol v1.1
AUTHOR
Makamaka Hannyaharamitu, <makamaka[at]cpan.org>
COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify it
under the same terms as Perl itself.
JSON-RPC-0.98/ex/ 0000755 0000000 0000000 00000000000 11472557432 0013271 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/ex/MyApp.pm 0000644 0000000 0000000 00000004660 11472557432 0014663 0 ustar 00root root 0000000 0000000 package
MyApp;
use 5.006;
use strict;
use base qw(JSON::RPC::Procedure); # requires Perl 5.6 or later
use Data::Dumper;
sub _allowable_procedure {
return {
echo => \&echo,
sum => \&sum,
};
}
sub echo : Public {
my ($s, $args) = @_;
return $args->[0];
}
sub now : Public() {
return scalar(localtime);
}
sub sum : Number(a:num, b:num) {
my ($s, $obj) = @_;
return $obj->{a} + $obj->{b};
}
sub sum2 : Public {
my $s = shift;
if ($s->version) { # JSONRPC 1.1
my $arg = shift;
return $arg->[0] + $arg->[1];
}
else { # JSONRPC 1.0
return $_[0] + $_[1];
}
}
sub sum3 : String(a, b) {
my $s = shift;
return $_[0]->{a} + $_[0]->{b};
}
sub sum4 : Private {
my $s = shift;
# This is private...
}
package
MyApp::system;
sub describe {
{
sdversion => "1.0",
name => 'MyApp',
};
}
1;
__END__
=pod
=head1 NAME
MyApp - sample JSON-RPC server class
=head1 DESCRIPTION
This module is a smple code (for Perl 5.6 or later).
Please check the source.
=head2 PROCEDURES
=over
=item echo
Takes a scalar and returns it as is.
=item now
Returns the current time.
=item sum
Takes two numbers and returns the total.
sum : Number(a:num, b:num)
The two numbers are automatically set into 'a' and 'b'.
=item sum2
Takes two numbers and returns the total.
sum2 : Public
This routine is a sample for both JSONRPC 1.1 and 1.0
=item sum3
Same as sum3 but its format is difference.
sum3 : String(a, b)
=item sum4
This is a private procedure, so client can't call this.
sum4 : Private
=back MyApp::system::describe
This is a reserved procedure returns a C<Service Description> object.
See to L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ServiceDescription>.
=item _allowable_procedure
If you change the name into C<allowable_procedure>,
clients are able to call C<echo> and C<sum> only.
C<allowable_procedure> is a special name and the method
returns a hash reference contains procedure names and its code reference.
sub allowable_procedure {
return {
echo => \&echo,
sum => \&sum,
};
}
=cut
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/ex/MyApp/ 0000755 0000000 0000000 00000000000 11472557432 0014317 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/ex/MyApp/Subclass.pm 0000644 0000000 0000000 00000001366 11472557432 0016442 0 ustar 00root root 0000000 0000000 package
MyApp::Subclass;
use strict;
use base qw(MyApp);
sub sum : String(a,b) {
my $s = shift;
return ($_[0]->{a} + $_[0]->{b}) * 2;
}
1;
__END__
=pod
=head1 NAME
MyApp::Subclass - sample JSON-RPC server class
=head1 DESCRIPTION
This module is a smple code (for Perl 5.6 or later).
Please check the source.
It is a MyApp subclass, so methods are inherited.
=head2 PROCEDURES
=over
=item sum
Takes two numbers and returns the added and multiplied number.
=cut
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/ex/client.pl 0000644 0000000 0000000 00000001364 11472557432 0015110 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
use strict;
use JSON::RPC::Client;
my $cgi_uri = 'http://example.com/cgi-bin/json/server.cgi/API'; # CGI
my $uri = 'http://example.com/jsonrpc/API'; # Apache2 or daemon
my $client = new JSON::RPC::Client;
$client->prepare( $uri, ['sum', 'echo'] ); # if call /API/Sublcass, sum method return (sum * 2)
print $client->sum(10, 23), "\n";
print $client->echo("abc\ndef"), "\n";
my $callobj = {
method => 'sum2',
params => [ 17, 25 ], # ex.) params => { a => 20, b => 10 } for JSON-RPC v1.1
};
my $res = $client->call($cgi_uri, $callobj);
if($res) {
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
JSON-RPC-0.98/ex/jsonrpc.conf 0000644 0000000 0000000 00000000701 11472557432 0015614 0 ustar 00root root 0000000 0000000
PerlRequire /your/script/path/start.pl
<Location /jsonrpc/API>
SetHandler perl-script
PerlResponseHandler JSON::RPC::Server::Apache
PerlSetVar dispatch "MyApp"
PerlSetVar return_die_message 0
</Location>
<Location /jsonrpc/API/Subclass>
SetHandler perl-script
PerlResponseHandler JSON::RPC::Server::Apache
PerlSetVar dispatch "MyApp::Subclass"
PerlSetVar return_die_message 0
</Location>
JSON-RPC-0.98/ex/server.cgi 0000644 0000000 0000000 00000000361 11472557432 0015263 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
# JSON-RPC Server (daemon version)
use strict;
use JSON::RPC::Server::CGI;
my $server = JSON::RPC::Server::CGI->new;
$server->dispatch_to({'/API' => 'MyApp', '/API/Subclass' => 'MyApp::Subclass'})->handle();
__END__
JSON-RPC-0.98/ex/serverd.pl 0000644 0000000 0000000 00000000415 11472557432 0015300 0 ustar 00root root 0000000 0000000 #!/usr/bin/perl -w
# JSON-RPC Server (daemon version)
use JSON::RPC::Server::Daemon;
my $server = JSON::RPC::Server::Daemon->new(LocalPort => 8080);
$server->dispatch_to({'/jsonrpc/API' => 'MyApp', '/jsonrpc/API/Subclass' => 'MyApp::Subclass'})->handle();
__END__
JSON-RPC-0.98/lib/ 0000755 0000000 0000000 00000000000 11472557432 0013423 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/lib/JSON/ 0000755 0000000 0000000 00000000000 11472557432 0014174 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/lib/JSON/RPC.pm 0000644 0000000 0000000 00000005611 11472557432 0015161 0 ustar 00root root 0000000 0000000 package JSON::RPC;
use strict;
$JSON::RPC::VERSION = '0.96';
1;
__END__
=pod
=head1 NAME
JSON::RPC - Perl implementation of JSON-RPC 1.1 protocol
=head1 DESCRIPTION
JSON-RPC is a stateless and light-weight remote procedure call (RPC)
protocol for inter-networking applications over HTTP. It uses JSON
as the data format for of all facets of a remote procedure call,
including all application data carried in parameters.
quoted from L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>.
This module was in JSON package on CPAN before.
Now its interfaces was completely changed.
The old modules - L<JSONRPC::Transport::HTTP> and L<Apache::JSONRPC> are deprecated.
Please try to use JSON::RPC::Server and JSON::RPC::Client which support both JSON-RPC
protocol version 1.1 and 1.0.
=head1 EXAMPLES
CGI version.
#--------------------------
# In your application class
package MyApp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
sub echo : Public { # new version style. called by clients
# first argument is JSON::RPC::Server object.
return $_[1];
}
sub sum : Public(a:num, b:num) { # sets value into object member a, b.
my ($s, $obj) = @_;
# return a scalar value or a hashref or an arryaref.
return $obj->{a} + $obj->{b};
}
sub a_private_method : Private {
# ... can't be called by client
}
sub sum_old_style { # old version style. taken as Public
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
#--------------------------
# In your triger script.
use JSON::RPC::Server::CGI;
use MyApp;
# simple
JSON::RPC::Server::CGI->dispatch('MyApp')->handle();
# or
JSON::RPC::Server::CGI->dispatch([qw/MyApp FooBar/])->handle();
# or INFO_PATH version
JSON::RPC::Server::CGI->dispatch({'/Test' => 'MyApp'})->handle();
#--------------------------
# Client
use JSON::RPC::Client;
my $client = new JSON::RPC::Client;
my $uri = 'http://www.example.com/jsonrpc/Test';
my $obj = {
method => 'sum', # or 'MyApp.sum'
params => [10, 20],
};
my $res = $client->call( $uri, $obj )
if($res){
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
# or
$client->prepare($uri, ['sum', 'echo']);
print $client->sum(10, 23);
See to L<JSON::RPC::Server::CGI>, L<JSON::RPC::Server::Daemon>, L<JSON::RPC::Server::Apache>
L<JSON::RPC::Client> and L<JSON::RPC::Procedure>.
=head1 ABOUT NEW VERSION
=over
=item supports JSON-RPC protocol v1.1
=back
=head1 TODO
=over
=item Document
=item Examples
=item More Tests
=back
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/ 0000755 0000000 0000000 00000000000 11472557432 0014620 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/lib/JSON/RPC/Client.pm 0000644 0000000 0000000 00000022132 11472557432 0016374 0 ustar 00root root 0000000 0000000 ##############################################################################
# JSONRPC version 1.1
# http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html
##############################################################################
use strict;
use JSON ();
use Carp ();
##############################################################################
package JSON::RPC::Client;
$JSON::RPC::Client::VERSION = '0.93';
use LWP::UserAgent;
BEGIN {
for my $method (qw/uri ua json content_type version id allow_call status_line/) {
eval qq|
sub $method {
\$_[0]->{$method} = \$_[1] if defined \$_[1];
\$_[0]->{$method};
}
|;
}
}
sub AUTOLOAD {
my $self = shift;
my $method = $JSON::RPC::Client::AUTOLOAD;
$method =~ s/.*:://;
return if ($method eq 'DESTROY');
$method =~ s/^__(\w+)__$/$1/; # avoid to call built-in methods (ex. __VERSION__ => VERSION)
unless ( exists $self->allow_call->{ $method } ) {
Carp::croak("Can't call the method not allowed by prepare().");
}
my @params = @_;
my $obj = {
method => $method,
params => (ref $_[0] ? $_[0] : [@_]),
};
my $ret = $self->call($self->uri, $obj);
if ( $ret and $ret->is_success ) {
return $ret->result;
}
else {
Carp::croak ( $ret ? '(Procedure error) ' . $ret->error_message : $self->status_line );
}
}
sub create_json_coder {
JSON->new->allow_nonref->utf8;
}
sub new {
my $proto = shift;
my $self = bless {}, (ref $proto ? ref $proto : $proto);
my $ua = LWP::UserAgent->new(
agent => 'JSON::RPC::Client/' . $JSON::RPC::Client::VERSION . ' beta ',
timeout => 10,
);
$self->ua($ua);
$self->json( $proto->create_json_coder );
$self->version('1.1');
$self->content_type('application/json');
return $self;
}
sub prepare {
my ($self, $uri, $procedures) = @_;
$self->uri($uri);
$self->allow_call({ map { ($_ => 1) } @$procedures });
}
sub call {
my ($self, $uri, $obj) = @_;
my $result;
if ($uri =~ /\?/) {
$result = $self->_get($uri);
}
else {
Carp::croak "not hashref." unless (ref $obj eq 'HASH');
$result = $self->_post($uri, $obj);
}
my $service = $obj->{method} =~ /^system\./ if ( $obj );
$self->status_line($result->status_line);
if ($result->is_success) {
return unless($result->content); # notification?
if ($service) {
return JSON::RPC::ServiceObject->new($result, $self->json);
}
return JSON::RPC::ReturnObject->new($result, $self->json);
}
else {
return;
}
}
sub _post {
my ($self, $uri, $obj) = @_;
my $json = $self->json;
$obj->{version} ||= $self->{version} || '1.1';
if ($obj->{version} eq '1.0') {
delete $obj->{version};
if (exists $obj->{id}) {
$self->id($obj->{id}) if ($obj->{id}); # if undef, it is notification.
}
else {
$obj->{id} = $self->id || ($self->id('JSON::RPC::Client'));
}
}
else {
$obj->{id} = $self->id if (defined $self->id);
}
my $content = $json->encode($obj);
$self->ua->post(
$uri,
Content_Type => $self->{content_type},
Content => $content,
Accept => 'application/json',
);
}
sub _get {
my ($self, $uri) = @_;
$self->ua->get(
$uri,
Accept => 'application/json',
);
}
##############################################################################
package JSON::RPC::ReturnObject;
$JSON::RPC::ReturnObject::VERSION = $JSON::RPC::VERSION;
BEGIN {
for my $method (qw/is_success content jsontext version/) {
eval qq|
sub $method {
\$_[0]->{$method} = \$_[1] if defined \$_[1];
\$_[0]->{$method};
}
|;
}
}
sub new {
my ($class, $obj, $json) = @_;
my $content = ( $json || JSON->new->utf8 )->decode( $obj->content );
my $self = bless {
jsontext => $obj->content,
content => $content,
}, $class;
$content->{error} ? $self->is_success(0) : $self->is_success(1);
$content->{version} ? $self->version(1.1) : $self->version(0) ;
$self;
}
sub is_error { !$_[0]->is_success; }
sub error_message {
$_[0]->version ? $_[0]->{content}->{error}->{message} : $_[0]->{content}->{error};
}
sub result {
$_[0]->{content}->{result};
}
##############################################################################
package JSON::RPC::ServiceObject;
use base qw(JSON::RPC::ReturnObject);
sub sdversion {
$_[0]->{content}->{sdversion} || '';
}
sub name {
$_[0]->{content}->{name} || '';
}
sub result {
$_[0]->{content}->{summary} || '';
}
1;
__END__
=pod
=head1 NAME
JSON::RPC::Client - Perl implementation of JSON-RPC client
=head1 SYNOPSIS
use JSON::RPC::Client;
my $client = new JSON::RPC::Client;
my $url = 'http://www.example.com/jsonrpc/API';
my $callobj = {
method => 'sum',
params => [ 17, 25 ], # ex.) params => { a => 20, b => 10 } for JSON-RPC v1.1
};
my $res = $client->call($uri, $callobj);
if($res) {
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
# Easy access
$client->prepare($uri, ['sum', 'echo']);
print $client->sum(10, 23);
=head1 DESCRIPTION
This is JSON-RPC Client.
See L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>.
Gets a perl object and convert to a JSON request data.
Sends the request to a server.
Gets a response returned by the server.
Converts the JSON response data to the perl object.
=head1 JSON::RPC::Client
=head2 METHODS
=over
=item $client = JSON::RPC::Client->new
Creates new JSON::RPC::Client object.
=item $response = $client->call($uri, $procedure_object)
Calls to $uri with $procedure_object.
The request method is usually C<POST>.
If $uri has query string, method is C<GET>.
About 'GET' method,
see to L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#GetProcedureCall>.
Return value is L</JSON::RPC::ReturnObject>.
=item $client->prepare($uri, $arrayref_of_procedure)
Allow to call methods in contents of $arrayref_of_procedure.
Then you can call the prepared methods with an array reference or a list.
The return value is a result part of JSON::RPC::ReturnObject.
$client->prepare($uri, ['sum', 'echo']);
$res = $client->echo('foobar'); # $res is 'foobar'.
$res = $client->sum(10, 20); # sum up
$res = $client->sum( [10, 20] ); # same as above
If you call a method which is not prepared, it will C<croak>.
Currently, B<can't call any method names as same as built-in methods>.
=item version
Sets the JSON-RPC protocol version.
1.1 by default.
=item id
Sets a request identifier.
In JSON-RPC 1.1, it is optoinal.
If you set C<version> 1.0 and don't set id,
the module sets 'JSON::RPC::Client' to it.
=item ua
Setter/getter to L<LWP::UserAgent> object.
=item json
Setter/getter to the JSON coder object.
Default is L<JSON>, likes this:
$self->json( JSON->new->allow_nonref->utf8 );
$json = $self->json;
This object serializes/deserializes JSON data.
By default, returned JSON data assumes UTF-8 encoded.
=item status_line
Returns status code;
After C<call> a remote procedure, the status code is set.
=item create_json_coder
(Class method)
Returns a JSON de/encoder in C<new>.
You can override it to use your favorite JSON de/encoder.
=back
=head1 JSON::RPC::ReturnObject
C<call> method or the methods set by C<prepared> returns this object.
(The returned JSON data is decoded by the JSON coder object which was passed
by the client object.)
=head2 METHODS
=over
=item is_success
If the call is successful, returns a true, otherwise a false.
=item is_error
If the call is not successful, returns a true, otherwise a false.
=item error_message
If the response contains an error message, returns it.
=item result
Returns the result part of a data structure returned by the called server.
=item content
Returns the whole data structure returned by the called server.
=item jsontext
Returns the row JSON data.
=item version
Returns the version of this response data.
=back
=head1 JSON::RPC::ServiceObject
=head1 RESERVED PROCEDURE
When a client call a procedure (method) name 'system.foobar',
JSON::RPC::Server look up MyApp::system::foobar.
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ProcedureCall>
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ServiceDescription>
There is JSON::RPC::Server::system::describe for default response of 'system.describe'.
=head1 SEE ALSO
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>
L<http://json-rpc.org/wiki/specification>
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/Procedure.pm 0000644 0000000 0000000 00000006537 11472557432 0017121 0 ustar 00root root 0000000 0000000 package JSON::RPC::Procedure;
#
# http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html
#
$JSON::RPC::Procedure::VERSION = '0.90';
use strict;
use attributes;
use Carp ();
my $Procedure = {};
sub check { $Procedure->{$_[0]} ? attributes::get($_[1]) : {}; }
sub FETCH_CODE_ATTRIBUTES {
my ($pkg, $code) = @_;
my $procedure = $Procedure->{$pkg}{$code} || { return_type => undef, argument_type => undef };
return {
return_type => $procedure->{return_type},
argument_type => $procedure->{argument_type},
};
}
sub MODIFY_CODE_ATTRIBUTES {
my ($pkg, $code, $attr) = @_;
my ($ret_type, $args);
if ($attr =~ /^([A-Z][a-z]+)(?:\(\s*([^)]*)\s*\))?$/) {
$ret_type = $1 if (defined $1);
$args = $2 if (defined $2);
}
unless ($ret_type =~ /^Private|Public|Arr|Obj|Bit|Bool|Num|Str|Nil|None/) {
Carp::croak("Invalid type '$attr'. Specify 'Parivate' or 'Public' or One of JSONRPC Return Types.");
}
if ($ret_type ne 'Private' and defined $args) {
$Procedure->{$pkg}{$code}{argument_type} = _parse_argument_type($args);
}
$Procedure->{$pkg}{$code}{return_type} = $ret_type;
return;
}
sub _parse_argument_type {
my $text = shift;
my $declaration;
my $pos;
my $name;
$text =~ /^([,: a-zA-Z0-9]*)?$/;
unless ( defined($declaration = $1) ) {
Carp::croak("Invalid argument type.");
}
my @args = split/\s*,\s*/, $declaration;
my $i = 0;
$pos = [];
$name = {};
for my $arg (@args) {
if ($arg =~ /([_0-9a-zA-Z]+)(?::([a-z]+))?/) {
push @$pos, $1;
$name->{$1} = $2;
}
}
return {
position => $pos,
names => $name,
};
}
1;
__END__
=pod
=head1 NAME
JSON::RPC::Procedure - JSON-RPC Service attributes
=head1 SYNOPSIS
package MyApp;
use base ('JSON::RPC::Procedure');
sub sum : Public {
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
# or
sub sum : Public(a, b) {
my ($s, $obj) = @_;
return $obj->{a} + $obj->{b};
}
# or
sub sum : Number(a:num, b:num) {
my ($s, $obj) = @_;
return $obj->{a} + $obj->{b};
}
# private method can't be called by clients
sub _foobar : Private {
# ...
}
=head1 DESCRIPTION
Using this module, you can write a subroutine with a special attribute.
Currently, in below attributes, only Public and Private are available.
Others are same as Public.
=over
=item Public
Means that a client can call this procedure.
=item Private
Means that a client can't call this procedure.
=item Arr
Means that its return values is an array object.
=item Obj
Means that its return values is a member object.
=item Bit
=item Bool
Means that a return values is a C<true> or C<false>.
=item Num
Means that its return values is a number.
=item Str
Means that its return values is a string.
=item Nil
=item None
Means that its return values is a C<null>.
=back
=head1 TODO
=over
=item Auto Service Description
=item Type check
=back
=head1 SEE ALSO
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/Server.pm 0000644 0000000 0000000 00000035400 11472557432 0016426 0 ustar 00root root 0000000 0000000 ##############################################################################
# JSONRPC version 1.1
# http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html
##############################################################################
use strict;
use JSON ();
use Carp ();
use HTTP::Request ();
use HTTP::Response ();
##############################################################################
package JSON::RPC::Server;
my $JSONRPC_Procedure_Able;
BEGIN {
if ($] >= 5.006) {
require JSON::RPC::Procedure;
$JSONRPC_Procedure_Able = 1;
}
}
$JSON::RPC::Server::VERSION = '0.92';
BEGIN {
for my $method (qw/request path_info json version error_message max_length charset content_type
error_response_header return_die_message/)
{
eval qq|
sub $method {
\$_[0]->{$method} = \$_[1] if defined \$_[1];
\$_[0]->{$method};
}
|;
}
}
sub create_json_coder {
JSON->new->utf8; # assumes UTF8
}
sub new {
my $class = shift;
bless {
max_length => 1024 * 100,
charset => 'UTF-8',
content_type => 'application/json',
json => $class->create_json_coder,
loaded_module => { name => {}, order => [], },
@_,
}, $class;
}
*dispatch_to = *dispatch; # Alias
sub dispatch {
my ($self, @arg) = @_;
if (@arg == 0){
Carp::carp "Run test mode...";
}
elsif (@arg > 1) {
for my $pkg (@arg) {
$self->_load_module($pkg);
}
}
else {
if (ref $arg[0] eq 'ARRAY') {
for my $pkg (@{$arg[0]}) {
$self->_load_module($pkg);
}
}
elsif (ref $arg[0] eq 'HASH') { # Lazy loading
for my $path (keys %{$arg[0]}) {
my $pkg = $arg[0]->{$path};
$self->{dispatch_path}->{$path} = $pkg;
}
}
elsif (ref $arg[0]) {
Carp::croak 'Invalid dispatch value.';
}
else { # Single module
$self->_load_module($arg[0]);
}
}
$self;
}
sub handle {
my ($self) = @_;
my ($obj, $res, $jsondata);
if ($self->request->method eq 'POST') {
$jsondata = $self->retrieve_json_from_post();
}
elsif ($self->request->method eq 'GET') {
$jsondata = $self->retrieve_json_from_get();
}
if ( $jsondata ) {
$obj = eval q| $self->json->decode($jsondata) |;
if ($@) {
$self->raise_error(code => 201, message => "Can't parse JSON data.");
}
}
else { # may have error_response_header at retroeve_json_from_post / get
unless ($self->error_response_header) {
$self->error_response_header($self->response_header(403, 'No data.'));
}
}
if ($obj) {
$res = $self->_handle($obj);
unless ($self->error_response_header) {
return $self->response( $self->response_header(200, $res) );
}
}
$self->response( $self->error_response_header );
}
sub retrieve_json_from_post { } # must be implemented in subclass
sub retrieve_json_from_get { } # must be implemented in subclass
sub response { } # must be implemented in subclass
sub raise_error {
my ($self, %opt) = @_;
my $status_code = $opt{status_code} || 200;
if (exists $opt{version} and $opt{version} ne '1.1') {
$self->version(0);
}
else {
$self->version(1.1);
}
my $res = $self->_error($opt{id}, $opt{code}, $opt{message});
$self->error_response_header($self->response_header($status_code, $res));
return;
}
sub response_header {
my ($self, $code, $result) = @_;
my $h = HTTP::Headers->new;
$h->header('Content-Type' => $self->content_type . '; charset=' . $self->charset);
HTTP::Response->new($code => undef, $h, $result);
}
sub _handle {
my ($self, $obj) = @_;
$obj->{version} ? $self->version(1.1) : $self->version(0);
my $method = $obj->{method};
if (!defined $method) {
return $self->_error($obj->{id}, 300, "method is nothing.");
}
elsif ($method =~ /[^-._a-zA-Z0-9]/) {
return $self->_error($obj->{id}, 301, "method is invalid.");
}
my $procedure = $self->_find_procedure($method);
unless ($procedure) {
return $self->_error($obj->{id}, 302, "No such a method : '$method'.");
}
my $params;
unless ($obj->{version}) {
unless ($obj->{params} and ref($obj->{params}) eq 'ARRAY') {
return $self->_error($obj->{id}, 400, "Invalid params for JSONRPC 1.0.");
}
}
unless ($params = $self->_argument_type_check($procedure->{argument_type}, $obj->{params})) {
return $self->_error($obj->{id}, 401, $self->error_message);
}
my $result;
if ($obj->{version}) {
$result = ref $params ? eval q| $procedure->{code}->($self, $params) |
: eval q| $procedure->{code}->($self) |
;
}
else {
my @params;
if(ref($params) eq 'ARRAY') {
@params = @$params;
}
else {
$params[0] = $params;
}
$result = eval q| $procedure->{code}->($self, @params) |;
}
if ($self->error_response_header) {
return;
}
elsif ($@) {
return $self->_error($obj->{id}, 500, ($self->return_die_message ? $@ : 'Procedure error.'));
}
if (!$obj->{version} and !defined $obj->{id}) { # notification
return '';
}
my $return_obj = {result => $result};
if ($obj->{version}) {
$return_obj->{version} = '1.1';
}
else {
$return_obj->{error} = undef;
$return_obj->{id} = $obj->{id};
}
return $self->json->encode($return_obj);
}
sub _find_procedure {
my ($self, $method) = @_;
my $found;
my $classname;
my $system_call;
if ($method =~ /^system\.(\w+)$/) {
$system_call = 1;
$method = $1;
}
elsif ($method =~ /\./) {
my @p = split/\./, $method;
$method = pop @p;
$classname= join('::', @p);
}
if ($self->{dispatch_path}) {
my $path = $self->{path_info};
if (my $pkg = $self->{dispatch_path}->{$path}) {
return if ( $classname and $pkg ne $classname );
return if ( $JSONRPC_Procedure_Able and JSON::RPC::Procedure->can( $method ) );
$self->_load_module($pkg);
if ($system_call) { $pkg .= '::system' }
return $self->_method_is_ebable($pkg, $method, $system_call);
}
}
else {
for my $pkg (@{$self->{loaded_module}->{order}}) {
next if ( $classname and $pkg ne $classname );
next if ( $JSONRPC_Procedure_Able and JSON::RPC::Procedure->can( $method ) );
if ($system_call) { $pkg .= '::system' }
if ( my $ret = $self->_method_is_ebable($pkg, $method, $system_call) ) {
return $ret;
}
}
}
return;
}
sub _method_is_ebable {
my ($self, $pkg, $method, $system_call) = @_;
my $allowable_procedure = $pkg->can('allowable_procedure');
my $code;
if ( $allowable_procedure ) {
if ( exists $allowable_procedure->()->{ $method } ) {
$code = $allowable_procedure->()->{ $method };
}
else {
return;
}
}
if ( $code or ( $code = $pkg->can($method) ) ) {
return {code => $code} if ($system_call or !$JSONRPC_Procedure_Able);
if ( my $procedure = JSON::RPC::Procedure::check($pkg, $code) ) {
return if ($procedure->{return_type} and $procedure->{return_type} eq 'Private');
$procedure->{code} = $code;
return $procedure;
}
}
if ($system_call) { # if not found, default system.foobar
if ( my $code = 'JSON::RPC::Server::system'->can($method) ) {
return {code => $code};
}
}
return;
}
sub _argument_type_check {
my ($self, $type, $params) = @_;
unless (defined $type) {
return defined $params ? $params : 1;
}
my $regulated;
if (ref $params eq 'ARRAY') {
if (@{$type->{position}} != @$params) {
$self->error_message("Number of params is mismatch.");
return;
}
if (my $hash = $type->{names}) {
my $i = 0;
for my $name (keys %$hash) {
$regulated->{$name} = $params->[$i++];
}
}
}
elsif (ref $params eq 'HASH') {
if (@{$type->{position}} != keys %$params) {
$self->error_message("Number of params is mismatch.");
return;
}
if (my $hash = $type->{names}) {
my $i = 0;
for my $name (keys %$params) {
if ($name =~ /^\d+$/) {
my $realname = $type->{position}[$name];
$regulated->{$realname} = $params->{$name};
}
else {
$regulated->{$name} = $params->{$name};
}
}
}
}
elsif (!defined $params) {
if (@{$type->{position}} != 0) {
$self->error_message("Number of params is mismatch.");
return;
}
return 1;
}
else {
$self->error_message("the params member is any other type except JSON Object or Array.");
return;
}
return $regulated ? $regulated : $params;
}
sub _load_module {
my ($self, $pkg) = @_;
eval qq| require $pkg |;
if ($@) {
Carp::croak $@;
}
$self->{loaded_module}->{name}->{$pkg} = $pkg;
push @{ $self->{loaded_module}->{order} }, $pkg;
}
# Error Handling
sub _error {
my ($self, $id, $code, $message) = @_;
if ($self->can('translate_error_message')) {
$message = $self->translate_error_message($code, $message);
}
my $error_obj = {
name => 'JSONRPCError',
code => $code,
message => $message,
};
my $obj;
if ($self->version) {
$obj = {
version => "1.1",
error => $error_obj,
};
$obj->{id} = $id if (defined $id);
}
else {
return '' if (!defined $id);
$obj = {
result => undef,
error => $message,
id => $id,
};
}
return $self->json->encode($obj);
}
##############################################################################
package JSON::RPC::Server::system;
sub describe {
{
sdversion => "1.0",
name => __PACKAGE__,
summary => 'Default system description',
}
}
1;
__END__
=pod
=head1 NAME
JSON::RPC::Server - Perl implementation of JSON-RPC sever
=head1 SYNOPSIS
# CGI version
use JSON::RPC::Server::CGI;
my $server = JSON::RPC::Server::CGI->new;
$server->dispatch_to('MyApp')->handle();
# Apache version
# In apache conf
PerlRequire /your/path/start.pl
PerlModule MyApp
<Location /jsonrpc/API>
SetHandler perl-script
PerlResponseHandler JSON::RPC::Server::Apache
PerlSetVar dispatch "MyApp"
PerlSetVar return_die_message 0
</Location>
# Daemon version
use JSON::RPC::Server::Daemon;
JSON::RPC::Server::Daemon->new(LocalPort => 8080);
->dispatch({'/jsonrpc/API' => 'MyApp'})
->handle();
# FastCGI version
use JSON::RPC::Server::FastCGI;
my $server = JSON::RPC::Server::FastCGI->new;
$server->dispatch_to('MyApp')->handle();
=head1 DESCRIPTION
Gets a client request.
Parses its JSON data.
Passes the server object and the object decoded from the JSON data to your procedure (method).
Takes your returned value (scalar or arrayref or hashref).
Sends a response.
Well, you write your procedure code only.
=head1 METHODS
=over
=item new
Creates new JSON::RPC::Server object.
=item dispatch($package)
=item dispatch([$package1, $package1, ...])
=item dispatch({$path => $package, ...})
Sets your procedure module using package name list or arrayref or hashref.
Hashref version is used for path_info access.
=item dispatch_to
An alias to C<dispatch>.
=item handle
Runs server object and returns a response.
=item raise_error(%hash)
return $server->raise_error(
code => 501,
message => "This is error in my procedure."
);
Sets an error.
An error code number in your procedure is an integer between 501 and 899.
=item json
Setter/Getter to json encoder/decoder object.
The default value is L<JSON> object in the below way:
JSON->new->utf8
In your procedure, changes its behaviour.
$server->json->utf8(0);
The JSON coder creating method is C<create_json_coder>.
=item version
Setter/Getter to JSON-RPC protocol version used by a client.
If version is 1.1, returns 1.1. Otherwise returns 0.
=item charset
Setter/Getter to cahrset.
Default is 'UTF-8'.
=item content_type
Setter/Getter to content type.
Default is 'application/json'.
=item return_die_message
When your program dies in your procedure,
sends a return object with errror message 'Procedure error' by default.
If this option is set, uses C<die> message.
sub your_procedure {
my ($s) = @_;
$s->return_die_message(1);
die "This is test.";
}
=item retrieve_json_from_post
It is used by JSON::RPC::Server subclass.
=item retrieve_json_from_get
In the protocol v1.1, 'GET' request method is also allowable.
It is used by JSON::RPC::Server subclass.
=item response
It is used by JSON::RPC::Server subclass.
=item request
Returns L<HTTP::Request> object.
=item path_info
Returns PATH_INFO.
=item max_length
Returns max content-length to your application.
=item translate_error_message
Implemented in your subclass.
Three arguments (server object, error code and error message) are passed.
It must return a message.
sub translate_error_message {
my ($s, $code, $message) = @_;
return $translation_jp_message{$code};
}
=item create_json_coder
(Class method)
Returns a JSON de/encoder in C<new>.
You can override it to use your favorite JSON de/encode.
=back
=head1 RESERVED PROCEDURE
When a client call a procedure (method) name 'system.foobar',
JSON::RPC::Server look up MyApp::system::foobar.
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ProcedureCall>
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html#ServiceDescription>
There is JSON::RPC::Server::system::describe for default response of 'system.describe'.
=head1 SEE ALSO
L<JSON>
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>
L<http://json-rpc.org/wiki/specification>
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/Server/ 0000755 0000000 0000000 00000000000 11472557432 0016066 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/lib/JSON/RPC/Server/Apache2.pm 0000644 0000000 0000000 00000011174 11472557432 0017673 0 ustar 00root root 0000000 0000000 ##############################################################################
package JSON::RPC::Server::Apache2;
use strict;
use lib qw(/var/www/cgi-bin/json/);
use base qw(JSON::RPC::Server);
use Apache2::Const -compile => qw(OK HTTP_BAD_REQUEST SERVER_ERROR);
use APR::Table ();
use Apache2::RequestRec ();
use Apache2::RequestIO ();
use Apache2::RequestUtil ();
$JSON::RPC::Server::Apache::VERSION = '0.05';
sub handler {
my($r) = @_;
my $s = __PACKAGE__->new;
$s->request($r);
$s->{path_info} = $r->path_info;
my @modules = $r->dir_config('dispatch') || $r->dir_config('dispatch_to');
$s->return_die_message( $r->dir_config('return_die_message') );
$s->dispatch([@modules]);
$s->handle(@_);
Apache2::Const::OK;
}
sub new {
my $class = shift;
return $class->SUPER::new();
}
sub retrieve_json_from_post {
my $self = shift;
my $r = $self->request;
my $len = $r->headers_in()->get('Content-Length');
return if($r->method ne 'POST');
return if($len > $self->max_length);
my ($buf, $content);
while( $r->read($buf,$len) ){
$content .= $buf;
}
$content;
}
sub retrieve_json_from_get {
my $self = shift;
my $r = $self->request;
my $args = $r->args;
$args = '' if (!defined $args);
$self->{path_info} = $r->path_info;
my $params = {};
$self->version(1.1);
for my $pair (split/&/, $args) {
my ($key, $value) = split/=/, $pair;
if ( defined ( my $val = $params->{ $key } ) ) {
if ( ref $val ) {
push @{ $params->{ $key } }, $value;
}
else { # change a scalar into an arrayref
$params->{ $key } = [];
push @{ $params->{ $key } }, $val, $value;
}
}
else {
$params->{ $key } = $value;
}
}
my $method = $r->path_info;
$method =~ s{^.*/}{};
$self->{path_info} =~ s{/?[^/]+$}{};
$self->json->encode({
version => '1.1',
method => $method,
params => $params,
});
}
sub response {
my ($self, $response) = @_;
my $r = $self->request;
$r->content_type($self->content_type);
$r->print($response->content);
return ($response->code == 200)
? Apache2::Const::OK : Apache2::Const::SERVER_ERROR;
}
1;
__END__
=pod
=head1 NAME
JSON::RPC::Server::Apache2 - JSON-RPC sever for mod_perl2
=head1 SYNOPSIS
# In apache conf
PerlRequire /your/path/start.pl
PerlModule MyApp
<Location /jsonrpc/API>
SetHandler perl-script
PerlResponseHandler JSON::RPC::Server::Apache
PerlSetVar dispatch "MyApp"
PerlSetVar return_die_message 0
</Location>
#--------------------------
# In your application class
package MyApp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
sub echo : Public { # new version style. called by clients
# first argument is JSON::RPC::Server object.
return $_[1];
}
sub sum : Public(a:num, b:num) { # sets value into object member a, b.
my ($s, $obj) = @_;
# return a scalar value or a hashref or an arryaref.
return $obj->{a} + $obj->{b};
}
sub a_private_method : Private {
# ... can't be called by client
}
sub sum_old_style { # old version style. taken as Public
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
=head1 DESCRIPTION
Gets a client request.
Parses its JSON data.
Passes the server object and the object decoded from the JSON data to your procedure (method).
Takes your returned value (scalar or arrayref or hashref).
Sends a response.
Well, you write your procedure code only.
=head1 METHODS
They are inherited from the L<JSON::RPC::Server> methods basically.
The below methods are implemented in JSON::RPC::Server::Apache2.
=over
=item new
Creates new JSON::RPC::Server::Apache2 object.
=item handle
Runs server object and returns a response.
=item retrieve_json_from_post
retrieves a JSON request from the body in POST method.
=item retrieve_json_from_get
In the protocol v1.1, 'GET' request method is also allowable.
it retrieves a JSON request from the query string in GET method.
=item response
returns a response JSON data to a client.
=back
=head1 SEE ALSO
L<JSON::RPC::Server>,
L<JSON::RPC::Procedure>,
L<JSON>,
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>,
L<http://json-rpc.org/wiki/specification>,
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/Server/CGI.pm 0000644 0000000 0000000 00000007224 11472557432 0017033 0 ustar 00root root 0000000 0000000 ##############################################################################
package JSON::RPC::Server::CGI;
use strict;
use CGI;
use JSON::RPC::Server; # for old Perl 5.005
use base qw(JSON::RPC::Server);
$JSON::RPC::Server::CGI::VERSION = '0.92';
sub new {
my $class = shift;
my $self = $class->SUPER::new();
my $cgi = $self->cgi;
$self->request( HTTP::Request->new($cgi->request_method, $cgi->url) );
$self->path_info($cgi->path_info);
$self;
}
sub retrieve_json_from_post {
my $json = $_[0]->cgi->param('POSTDATA');
return $json;
}
sub retrieve_json_from_get {
my $self = shift;
my $cgi = $self->cgi;
my $params = {};
$self->version(1.1);
for my $name ($cgi->param) {
my @values = $cgi->param($name);
$params->{$name} = @values > 1 ? [@values] : $values[0];
}
my $method = $cgi->path_info;
$method =~ s{^.*/}{};
$self->{path_info} =~ s{/?[^/]+$}{};
$self->json->encode({
version => '1.1',
method => $method,
params => $params,
});
}
sub response {
my ($self, $response) = @_;
print "Status: " . $response->code . "\015\012" . $response->headers_as_string("\015\012")
. "\015\012" . $response->content;
}
sub cgi {
$_[0]->{cgi} ||= new CGI;
}
1;
__END__
=head1 NAME
JSON::RPC::Server::CGI - JSON-RPC sever for CGI
=head1 SYNOPSIS
# CGI version
#--------------------------
# In your CGI script
use JSON::RPC::Server::CGI;
my $server = JSON::RPC::Server::CGI->new;
$server->dispatch('MyApp')->handle();
# or an array ref setting
$server->dispatch( [qw/MyApp MyApp::Subclass/] )->handle();
# or a hash ref setting
$server->dispatch( {'/jsonrpc/API' => 'MyApp'} )->handle();
#--------------------------
# In your application class
package MyApp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
sub echo : Public { # new version style. called by clients
# first argument is JSON::RPC::Server object.
return $_[1];
}
sub sum : Public(a:num, b:num) { # sets value into object member a, b.
my ($s, $obj) = @_;
# return a scalar value or a hashref or an arryaref.
return $obj->{a} + $obj->{b};
}
sub a_private_method : Private {
# ... can't be called by client
}
sub sum_old_style { # old version style. taken as Public
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
=head1 DESCRIPTION
Gets a client request.
Parses its JSON data.
Passes the server object and the object decoded from the JSON data to your procedure (method).
Takes your returned value (scalar or arrayref or hashref).
Sends a response.
Well, you write your procedure code only.
=head1 METHODS
They are inherited from the L<JSON::RPC::Server> methods basically.
The below methods are implemented in JSON::RPC::Server::CGI.
=over
=item new
Creates new JSON::RPC::Server::CGI object.
=item retrieve_json_from_post
retrieves a JSON request from the body in POST method.
=item retrieve_json_from_get
In the protocol v1.1, 'GET' request method is also allowable.
it retrieves a JSON request from the query string in GET method.
=item response
returns a response JSON data to a client.
=item cgi
returns the L<CGI> object.
=back
=head1 SEE ALSO
L<JSON::RPC::Server>,
L<JSON::RPC::Procedure>,
L<JSON>,
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>,
L<http://json-rpc.org/wiki/specification>,
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSON/RPC/Server/Daemon.pm 0000644 0000000 0000000 00000006706 11472557432 0017640 0 ustar 00root root 0000000 0000000 ##############################################################################
package JSON::RPC::Server::Daemon;
use strict;
use JSON::RPC::Server; # for old Perl 5.005
use base qw(JSON::RPC::Server);
$JSON::RPC::Server::Daemon::VERSION = '0.03';
use Data::Dumper;
sub new {
my $class = shift;
my $self = $class->SUPER::new();
my $pkg;
if( grep { $_ =~ /^SSL_/ } @_ ){
$self->{_daemon_pkg} = $pkg = 'HTTP::Daemon::SSL';
}
else{
$self->{_daemon_pkg} = $pkg = 'HTTP::Daemon';
}
eval qq| require $pkg; |;
if($@){ die $@ }
$self->{_daemon} ||= $pkg->new(@_) or die;
return $self;
}
sub handle {
my $self = shift;
my %opt = @_;
my $d = $self->{_daemon} ||= $self->{_daemon_pkg}->new(@_) or die;
while (my $c = $d->accept) {
$self->{con} = $c;
while (my $r = $c->get_request) {
$self->request($r);
$self->path_info($r->url->path);
$self->SUPER::handle();
last;
}
$c->close;
}
}
sub retrieve_json_from_post {
return $_[0]->request->content;
}
sub retrieve_json_from_get {
}
sub response {
my ($self, $response) = @_;
$self->{con}->send_response($response);
}
1;
__END__
=head1 NAME
JSON::RPC::Server::Daemon - JSON-RPC sever for daemon
=head1 SYNOPSIS
# Daemon version
#--------------------------
# In your daemon server script
use JSON::RPC::Server::Daemon;
JSON::RPC::Server::Daemon->new(LocalPort => 8080);
->dispatch({'/jsonrpc/API' => 'MyApp'})
->handle();
#--------------------------
# In your application class
package MyApp;
use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
sub echo : Public { # new version style. called by clients
# first argument is JSON::RPC::Server object.
return $_[1];
}
sub sum : Public(a:num, b:num) { # sets value into object member a, b.
my ($s, $obj) = @_;
# return a scalar value or a hashref or an arryaref.
return $obj->{a} + $obj->{b};
}
sub a_private_method : Private {
# ... can't be called by client
}
sub sum_old_style { # old version style. taken as Public
my ($s, @arg) = @_;
return $arg[0] + $arg[1];
}
=head1 DESCRIPTION
This module is for http daemon servers using L<HTTP::Daemon> or L<HTTP::Daemon::SSL>.
=head1 METHODS
They are inherited from the L<JSON::RPC::Server> methods basically.
The below methods are implemented in JSON::RPC::Server::Daemon.
=over
=item new
Creates new JSON::RPC::Server::Daemon object.
Arguments are passed to L<HTTP::Daemon> or L<HTTP::Daemon::SSL>.
=item handle
Runs server object and returns a response.
=item retrieve_json_from_post
retrieves a JSON request from the body in POST method.
=item retrieve_json_from_get
In the protocol v1.1, 'GET' request method is also allowable.
it retrieves a JSON request from the query string in GET method.
=item response
returns a response JSON data to a client.
=back
=head1 SEE ALSO
L<HTTP::Daemon>,
L<HTTP::Daemon::SSL>,
L<JSON::RPC::Server>,
L<JSON::RPC::Procedure>,
L<JSON>,
L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>,
L<http://json-rpc.org/wiki/specification>,
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007-2008 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/lib/JSONRPC.pm 0000644 0000000 0000000 00000001300 11472557432 0015071 0 ustar 00root root 0000000 0000000 package JSONRPC;
use strict;
$JSONRPC::VERSION = '1.01';
warn "JSONRPC is deprecated. Please try to use JSON::RPC.";
1;
__END__
=pod
=head1 NAME
JSONRPC - (DEPRECATED) Perl implementation of JSON-RPC protocol
=head1 DESCRIPTION
C<JSONRPC> is an old version module. Instead this, please see to L<JSON::RPC>.
This package remains to guide to the new module C<JSON::RPC> which supports both
JSON-RPC protocol version 1.1 and 1.0.
=head1 AUTHOR
Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
=head1 COPYRIGHT AND LICENSE
Copyright 2007 by Makamaka Hannyaharamitu
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself.
=cut
JSON-RPC-0.98/t/ 0000755 0000000 0000000 00000000000 11472557432 0013120 5 ustar 00root root 0000000 0000000 JSON-RPC-0.98/t/00_pod.t 0000644 0000000 0000000 00000000231 11472557432 0014362 0 ustar 00root root 0000000 0000000 use strict;
$^W = 1;
use Test::More;
eval "use Test::Pod 1.00";
plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
all_pod_files_ok ();
JSON-RPC-0.98/t/01_use.t 0000644 0000000 0000000 00000000414 11472557432 0014400 0 ustar 00root root 0000000 0000000 use Test::More;
use strict;
BEGIN { plan tests => 1 };
use CGI;
use JSON::RPC::Client;
use JSON::RPC::Server;
ok(1); # If we made it this far, we're ok.
END {
warn "\nJSON::RPC::Server::CGI requires CGI.pm (>= 2.9.2)." if(CGI->VERSION < 2.92);
}
JSON-RPC-0.98/t/02_server.t 0000644 0000000 0000000 00000000726 11472557432 0015121 0 ustar 00root root 0000000 0000000 use Test::More;
use strict;
BEGIN { plan tests => 4 };
use JSON::RPC::Server;
my $server = JSON::RPC::Server->new;
isa_ok($server, 'JSON::RPC::Server');
isa_ok($server->json, 'JSON');
my $test = JSON::RPC::Server::Test->new;
isa_ok($test, 'JSON::RPC::Server');
isa_ok($test->json, 'DummyJSONCoder');
####
package JSON::RPC::Server::Test;
use base qw(JSON::RPC::Server);
sub create_json_coder {
bless {}, 'DummyJSONCoder';
}