package JSONRPC;

 # JSON-RPC server and client

use strict;
use JSON;

use vars qw($VERSION);

$VERSION = 0.992;


sub new {
    my $self = bless {}, shift;
    $self->jsonParser( JSON::Parser->new() );
    $self->jsonConverter( JSON::Converter->new );
    $self;
}


sub proxy { # re-bless a client class
    my ($self,$url,$proxy_url) = @_;
    $self = $self->new unless(ref($self));
    my $class = ref($self) ? ref($self) . '::Client' : 'JSONRPC::Client';
    $self = bless $self, $class;
    $self->{_proxy} = [$url,$proxy_url] if(@_ > 1);
    $self;
}


# JSONRPC::Transport::XXX->dispatch_to('MyApp')->handle();
# This module looks for the method from MyApp.pm.
# looks for a method from the corresponding package name when a client call it.
# At present, only the module name can be specified. 

sub dispatch_to {
    my $class = shift;
    my $self  = ref($class) ? $class : $class->new;
    my @srv   = @_;

    if(@srv){
        $self->{_dispatch_to} = [ @srv ] ;
        $self;
    }
    else{
        @{ $self->{_dispatch_to} };
    }
}


# to a reqeust from a response (subclass must have the implementation.)

sub handle { }


# get a request from client (subclass must have the implementation.)
# The return value is a HTTP::Request object.

sub request { }


# return a response (subclass must have the implementation.)

sub response { }


# an error that should cut connection (subclass must have the implementation.)

sub invalid_request {}


# the process in case not making response (subclass must have the implementation.)

sub no_response {}


# return a mthod name and any parameters from JSON-RPC data structure.

sub get_request_data {
    my $self   = shift;
    my $js     = $self->{json_data};
    my $method = $js->{method} || '';
    my $params = $js->{params} || [];
    return ($method,$params);
}


# look for the method from module names set by the dispatch_to().
# $r is a HTTP::Request object.

sub find_method {
    my ($self, $method, $r) = @_;
    my $path  = ($r and $r->uri) ? ($r->uri->path || '') : '';

    $path =~ s{^/|/$}{}g;
    $path =~ s{/}{::}g;

    no strict 'refs';

    for my $srv ( @{$self->{_dispatch_to}} ){

        if($srv =~ m{/}){ # URI
            my $class = _path_to_class($srv);
            if($path eq $class){
                unless(defined %{"$class\::"}){
                    eval qq| require $class |;
                    if($@){ warn $@; return; }
                }
                if(my $func = $class->can($method)){
                    return $func;
                }
            }
            else{
                next;
            }
        }
        else{
            if(my $func = $srv->can($method)){
                return $func;
            }
        }
    }

    return;
}

sub _path_to_class {
    my $path = $_[0];
    $path =~ s{^/|/$}{}g;
    $path =~ s{/}{::}g;
    return $path;
}

# execution of method : return value is JSON-RPC data struture.
# $func->($self,@$params) returns a scalar or a hash ref or an array ref.

sub handle_method {
    my ($self, $r)       = @_;
    my ($method,$params) = $self->get_request_data();

    if( my $func = $self->find_method($method, $r) ){
        my $result = $func->($self,@$params);
        $self->set_response_data($result)
    }
    else{
        $self->set_err('No such a method.');
    }
}


# execution of notification

sub notification {
    my $self  = shift;
    my ($method,$params) = $self->get_request_data();

    if(my $func = $self->find_method($method)){
        $func->($self,@$params);
    }

    return 1;
}


# convert Perl data into JSON for a response.

sub set_response_data {
    my $self  = shift;
    my $value = shift;
    my $id    = $self->request_id;
    my $error = $self->error;

    if(!defined $value){ $value = JSON::Null; }
    if(!defined $error){ $error = JSON::Null; }

    my $result = {
        id     => $id,
        result => $value,
        error  => $error,
    };

    return $self->jsonConverter->objToJson($result);
}


# convert Perl data into JSON for an error response.

sub set_err {
    my $self  = shift;
    my $error = shift;
    my $id    = $self->request_id;

    my $result = {
        id     => $id,
        result => JSON::Null,
        error  => $error,
    };

    return $self->jsonConverter->objToJson($result);
}


# accessor of error object

sub error {
    my $self = shift;
    $self->{_error} = $_[0] if(@_ > 0);
    $self->{_error};
}


# accessor of id

sub request_id {
    my $self = shift;

    if(@_ > 0){
        $self->{_request_id} = $_[0];
        if(ref($self->{_request_id}) =~ /JSON/ and !defined $self->{_request_id}->{value}){
            $self->{_request_id} = undef;
        }
    }

    $self->{_request_id};
}


# accessor to JSON::Parser

sub jsonParser {
    $_[0]->{json_parser} = $_[1] if(@_ > 1);
    return $_[0]->{json_parser};
}


# accessor to JSON::Converter

sub jsonConverter {
    $_[0]->{json_converter} = $_[1] if(@_ > 1);
    return $_[0]->{json_converter};
}


#
# Client
#

package JSONRPC::Client;

use base qw(JSONRPC);
use vars qw($AUTOLOAD);


sub AUTOLOAD {
    my $self = shift;
    my $attr = $AUTOLOAD;

    $attr =~ s/.*:://;

    return if($attr eq 'DESTROY');

    $attr =~ s/^_//;

    my $res = $self->call($attr,[@_])->result;

    if($res->error){
        $self->{_error} = $res->{error};
        return;
    }
    else{
        $res->result;
    }
}


# call($method, $params $id)
# without $id, 'JsonRpcClient' is set.
# explicitly set undef into $id, notification mode.

sub call {
    my ($self, $method, $params, $id) = @_;

    if(@_ == 3){ $id = 'JsonRpcClient'; }
    $self->{_id} = $id;

    my $content = eval q|
        $self->jsonConverter->objToJson({
            method => $method, params => $params, id => $id
        })
    | or die $@;

    $self->{_response} = $self->send($content);
    $self;
}


# post data (subclass must have the implementation.)

sub send {}


# return the result value.

sub result {
    my ($self) = @_;
    my $response  = $self->{_response};

    my $result = bless {
        success => $response->is_success,
        error   => undef,
        result  => undef,
        id      => undef,
    }, 'JSONRPC::Response';

    unless( $response->is_success ){
        $self->{_error} = $response->code;
        $result->error($response->code);
        return $result;
    }
    else{
        $self->{_error} = undef;
    }

    my $json = $response->content;
    my $obj  = eval q| $self->jsonParser->jsonToObj($json, {unmapping => 1}) |;

    return if(!$obj); # notification?

    if($obj->{id} eq $self->{_id}){
        $result->result( $obj->{result} );
        $result->error( $obj->{error} );
        $result->id( $obj->{id} );
    }

    return $result;
}


# accessor to status code. (when response is not sucessful, set status code)

sub error { $_[0]->{_error}; }


#
#
#

package JSONRPC::Response;

use base qw(HTTP::Response);

sub is_success { $_[0]->{success} }

sub result {
    $_[0]->{result} = $_[1] if(@_ > 1);
    $_[0]->{result};
}


sub error {
    $_[0]->{error} = $_[1] if(@_ > 1);
    $_[0]->{error};
}


sub id {
    $_[0]->{id} = $_[1] if(@_ > 1);
    $_[0]->{id};
}


1;
__END__


=head1 NAME

 JSONRPC - Perl implementation of JSON-RPC protocol

=head1 SYNOPSIS

 #--------------------------
 # In your application class
 package MyApp;

 sub own_method { # called by clients
     my ($server, @params) = @_; # $server is JSONRPC object.
     ...
     # return a scalar value or a hashref or an arryaref.
 }

 #--------------------------
 # In your main cgi script.
 use JSONRPC::Transport::HTTP;
 use MyApp;

 # a la XMLRPC::Lite
 JSONRPC::Transport::HTTP::CGI->dispatch_to('MyApp')->handle();


 #--------------------------
 # Client version
 use JSONRPC::Transport::HTTP;
 my $uri = 'http://www.example.com/MyApp/Test/';

 my $res = JSONRPC::Transport::HTTP
            ->proxy($uri)
            ->call('echo',['This is test.'])
            ->result;

 if($res->error){
   print $res->error,"\n";
 }
 else{
   print $res->result,"\n";
 }

 # or

 my $client = JSONRPC::Transport::HTTP->proxy($uri);
 
 print $client->echo('This is test.'); # the alias, _echo is same.


=head1 TRANSITION PLAN

In the next large update version, JSON and JSONRPC modules are split.

  JSONRPC* and Apache::JSONRPC are deleted from JSON dist.
  JSONRPC::Client, JSONRPC::Server and JSONRPC::Procedure in JSON::RPC dist.

  Modules in JSON::RPC dist supports JSONRPC protocol v1.1 and 1.0.


=head1 DESCRIPTION

This module implementes JSON-RPC (L<http://json-rpc.org/>) server
and client. Most ideas were borrowed from L<XMLRPC::Lite>.
Currently C<JSONRPC> provides CGI server function.


=head1 METHOD

=over 4


=item dispatch_to


=item handle


=item jsonParser

The accessor of a JSON::Parser object.

 my $srv = JSONRPC::Transport::HTTP::CGI->new;
 $srv->jsonParser->{unmapping} = 1;


=item jsonConverter

The accessor of a JSON::Converter object.

=item proxy($uri,[$proxy_uri])

takes a service uri and optional proxy uri.
returns a client object.

=back

=head1 SEE ALSO

L<JSONRPC::Transport::HTTP>
L<JSON>
L<XMLRPC::Lite>
L<http://json-rpc.org/>


=head1 AUTHOR

Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

Copyright 2005-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