wi12.unix7.org

I wrote it for small embedded automation. It use only stable and wide shared HTTP::Daemon and threads.

The example I publish without demonize code, config reader and other optional code for easy view.

Full small work application you can look there SOAP to JSON RPC convertor/ JSON RPC application

• JSON-RPC 2.0 Specification http://www.jsonrpc.org/specification

httpd.pl

#!/usr/bin/env perl
 
package aHTTP;
 
use strict;
use warnings;
use threads;
use Scalar::Util qw(blessed);
use MIME::Base64 qw(decode_base64 encode_base64);
use HTTP::Daemon;
use HTTP::Status;
 
sub new {
    my ($class, $port) = @_;
    my $daemon = HTTP::Daemon->new(
        LocalPort => $port,
        Reuse => 1
    );
    my %route;
    my $self = {
        daemon => $daemon,
        port => $port,
        route => \%route,
    };
    bless $self, $class;
    return $self;
}
 
sub daemon {
    my ($self, $daemon) = @_;
    return $self->{daemon} unless $daemon;
    $self->{daemon} = $daemon;
    $self;
}
 
sub route {
    my ($self, $route, $class, $method) = @_;
    unless ($class and $method) {
        return $self->{routes}->{$route};
    }
    $self->{routes}->{$route}->{class} = $class;
    $self->{routes}->{$route}->{method} = $method;
    $self;
}
 
sub run {
    my $self = shift;
    while (my $c = $self->daemon->accept) {
        my $class = blessed $self;
        threads->create(\&handler, $self, $c)->detach;
    }
}
 
sub log {
    my ($self, $message) = @_;
    print $message, "\n";
}
 
sub handler {
    my ($self, $c) = @_;
    my $req = $c->get_request;
 
    #### logger ####
    my $peer_addr = $c->peerhost;
    my $uri = $req->uri;
    my $method = $req->method;
    my $host = $req->header('Host');
    my $content = $req->content;
 
    $self->log("$peer_addr $method $host$uri $content");
 
    #### router ####
    my $path = $req->uri->path;
 
    my $p = $self->route($path);
    my $class = $p->{class};
    my $subr = $p->{method};
 
    if ($class and $subr) {
 
        my $obj = $class->new;
        my $res = $obj->$subr($content);
 
        $c->print("Content-Type: application/json");
        $c->send_crlf;
        $c->send_crlf;
        $c->print($res);
    } else {
        $c->send_error(RC_FORBIDDEN);
    }
    $c->close;
    undef($c);
}
 
1;
 
package aRPC;
 
use strict;
use warnings;
use JSON::PP qw(encode_json decode_json);
use Scalar::Util qw(reftype);
 
sub new {
    my $class = shift;
    my $self = {
    };
    bless $self, $class;
    return $self;
}
 
sub run {
    my ($self, $content) = @_;
    my $req = decode_json($content);
 
    my $method = $req->{method};
    my $params = $req->{params};
    my $id = $req->{id};
 
    my $res;
    my $err;
 
    unless (reftype $params) {
        eval { $res = $self->$method($params); };
        $err = $@;
    } elsif (reftype $params eq 'ARRAY') {
        my @params = @{$params};
        eval { $res =  $self->$method(@params); };
        $err = $@;
    } elsif (reftype $params eq 'HASH') {
        my %params = %{$params};
        eval { $res =  $self->$method(%params); };
        $err = $@;
    };
    my $body;
    unless ($err) {
        $body = {
            jsonrpc => "2.0",
            result => $res,
            id => $id
        };
    } else {
        $body = {
            jsonrpc => "2.0",
            error => {
                code => 1,
                message => "Generic error: $@",
            },
            id => $id
        }
    }
    encode_json($body);
}
 
sub hello {
    my ($self, $name) = @_;
    return undef unless $name;
    "Hi, $name!";
}
 
1;
 
use strict;
use warnings;
 
my $d = aHTTP->new(8081);
$d->route('/rpc', aRPC => 'run');
$d->run;
#EOF

# ./httpd.pl
127.0.0.1 POST 127.0.0.1:8081/rpc {"id":1,"jsonrpc":"2.0","method":"hello","params":"John"}

# curl -v --data-binary '{"id":1,"jsonrpc":"2.0","method":"hello","params":"John"}'  \
          -H 'content-type: text/json;' http://127.0.0.1:8081/rpc
*   Trying 127.0.0.1...
* Connected to 127.0.0.1 (127.0.0.1) port 8081 (#0)
> POST /rpc HTTP/1.1
> Host: 127.0.0.1:8081
> User-Agent: curl/7.48.0
> Accept: */*
> content-type: text/json;
> Content-Length: 57
> 
* upload completely sent off: 57 out of 57 bytes
Content-Type: text/json

{"result":"Hi, John!","id":1,"jsonrpc":"2.0"}