1package JSON::RPC::Procedure;
2
3#
4# http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html
5#
6
7$JSON::RPC::Procedure::VERSION = '0.90';
8
9use strict;
10use attributes;
11use Carp ();
12
13my $Procedure = {};
14
15
16sub check { $Procedure->{$_[0]} ? attributes::get($_[1]) : {}; }
17
18
19sub FETCH_CODE_ATTRIBUTES {
20    my ($pkg, $code) = @_;
21    my $procedure = $Procedure->{$pkg}{$code} || { return_type => undef, argument_type => undef };
22
23    return {
24        return_type   => $procedure->{return_type},
25        argument_type => $procedure->{argument_type},
26    };
27}
28
29
30sub MODIFY_CODE_ATTRIBUTES {
31    my ($pkg, $code, $attr) = @_;
32    my ($ret_type, $args);
33
34    if ($attr =~ /^([A-Z][a-z]+)(?:\(\s*([^)]*)\s*\))?$/) {
35        $ret_type = $1 if (defined $1);
36        $args     = $2 if (defined $2);
37    }
38
39    unless ($ret_type =~ /^Private|Public|Arr|Obj|Bit|Bool|Num|Str|Nil|None/) {
40        Carp::croak("Invalid type '$attr'. Specify 'Parivate' or 'Public' or One of JSONRPC Return Types.");
41    }
42
43    if ($ret_type ne 'Private' and defined $args) {
44        $Procedure->{$pkg}{$code}{argument_type} = _parse_argument_type($args);
45    }
46
47    $Procedure->{$pkg}{$code}{return_type} = $ret_type;
48
49    return;
50}
51
52
53
54sub _parse_argument_type {
55    my $text = shift;
56
57    my $declaration;
58    my $pos;
59    my $name;
60
61    $text =~ /^([,: a-zA-Z0-9]*)?$/;
62
63    unless ( defined($declaration = $1) ) {
64        Carp::croak("Invalid argument type.");
65    }
66
67    my @args = split/\s*,\s*/, $declaration;
68
69    my $i = 0;
70
71    $pos  = [];
72    $name = {};
73
74    for my $arg (@args) {
75        if ($arg =~ /([_0-9a-zA-Z]+)(?::([a-z]+))?/) {
76            push @$pos, $1;
77            $name->{$1} = $2;
78        }
79    }
80
81    return {
82        position    => $pos,
83        names       => $name,
84    };
85}
86
87
88
891;
90__END__
91
92=pod
93
94
95=head1 NAME
96
97JSON::RPC::Procedure - JSON-RPC Service attributes
98
99=head1 SYNOPSIS
100
101 package MyApp;
102
103 use base ('JSON::RPC::Procedure');
104
105 sub sum : Public {
106     my ($s, @arg) = @_;
107     return $arg[0] + $arg[1];
108 }
109
110 # or
111
112 sub sum : Public(a, b) {
113     my ($s, $obj) = @_;
114     return $obj->{a} + $obj->{b};
115 }
116
117 # or
118
119 sub sum : Number(a:num, b:num) {
120     my ($s, $obj) = @_;
121     return $obj->{a} + $obj->{b};
122 }
123
124 # private method can't be called by clients
125
126 sub _foobar : Private {
127     # ...
128 }
129
130
131=head1 DESCRIPTION
132
133Using this module, you can write a subroutine with a special attribute.
134
135
136Currently, in below attributes, only Public and Private are available.
137Others are same as Public.
138
139=over
140
141=item Public
142
143Means that a client can call this procedure.
144
145=item Private
146
147Means that a client can't call this procedure.
148
149=item Arr
150
151Means that its return values is an array object.
152
153=item Obj
154
155Means that its return values is a member object.
156
157=item Bit
158
159=item Bool
160
161Means that a return values is a C<true> or C<false>.
162
163
164=item Num
165
166Means that its return values is a number.
167
168=item Str
169
170Means that its return values is a string.
171
172=item Nil
173
174=item None
175
176Means that its return values is a C<null>.
177
178=back
179
180
181=head1 TODO
182
183=over
184
185=item Auto Service Description
186
187
188=item Type check
189
190=back
191
192=head1 SEE ALSO
193
194L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>
195
196
197=head1 AUTHOR
198
199Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
200
201
202=head1 COPYRIGHT AND LICENSE
203
204Copyright 2007 by Makamaka Hannyaharamitu
205
206This library is free software; you can redistribute it and/or modify
207it under the same terms as Perl itself.
208
209
210=cut
211