JSON::RPC::Procedure - JSON-RPC Service attributes

 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 {
     # ...
 }

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__