1##############################################################################
2package JSON::RPC::Server::CGI;
3
4use strict;
5use CGI;
6use JSON::RPC::Server; # for old Perl 5.005
7
8use base qw(JSON::RPC::Server);
9
10$JSON::RPC::Server::CGI::VERSION = '0.92';
11
12sub new {
13    my $class = shift;
14    my $self  = $class->SUPER::new();
15    my $cgi   = $self->cgi;
16
17    $self->request( HTTP::Request->new($cgi->request_method, $cgi->url) );
18    $self->path_info($cgi->path_info);
19
20    $self;
21}
22
23
24sub retrieve_json_from_post {
25    my $json = $_[0]->cgi->param('POSTDATA');
26    return $json;
27}
28
29
30sub retrieve_json_from_get {
31    my $self   = shift;
32    my $cgi    = $self->cgi;
33    my $params = {};
34
35    $self->version(1.1);
36
37    for my $name ($cgi->param) {
38        my @values = $cgi->param($name);
39        $params->{$name} = @values > 1 ? [@values] : $values[0];
40    }
41
42    my $method = $cgi->path_info;
43
44    $method =~ s{^.*/}{};
45    $self->{path_info} =~ s{/?[^/]+$}{};
46
47    $self->json->encode({
48        version => '1.1',
49        method  => $method,
50        params  => $params,
51    });
52}
53
54
55sub response {
56    my ($self, $response) = @_;
57    print "Status: " . $response->code . "\015\012" . $response->headers_as_string("\015\012")
58           . "\015\012" . $response->content;
59}
60
61
62sub cgi {
63    $_[0]->{cgi} ||= new CGI;
64}
65
66
67
681;
69__END__
70
71
72=head1 NAME
73
74JSON::RPC::Server::CGI - JSON-RPC sever for CGI
75
76=head1 SYNOPSIS
77
78 # CGI version
79 #--------------------------
80 # In your CGI script
81 use JSON::RPC::Server::CGI;
82
83 my $server = JSON::RPC::Server::CGI->new;
84
85 $server->dispatch('MyApp')->handle();
86
87 # or  an array ref setting
88
89 $server->dispatch( [qw/MyApp MyApp::Subclass/] )->handle();
90
91 # or a hash ref setting
92
93 $server->dispatch( {'/jsonrpc/API' => 'MyApp'} )->handle();
94
95
96 #--------------------------
97 # In your application class
98 package MyApp;
99
100 use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than
101
102 sub echo : Public {    # new version style. called by clients
103     # first argument is JSON::RPC::Server object.
104     return $_[1];
105 }
106
107 sub sum : Public(a:num, b:num) { # sets value into object member a, b.
108     my ($s, $obj) = @_;
109     # return a scalar value or a hashref or an arryaref.
110     return $obj->{a} + $obj->{b};
111 }
112
113 sub a_private_method : Private {
114     # ... can't be called by client
115 }
116
117 sub sum_old_style {  # old version style. taken as Public
118     my ($s, @arg) = @_;
119    return $arg[0] + $arg[1];
120 }
121
122=head1 DESCRIPTION
123
124Gets a client request.
125
126Parses its JSON data.
127
128Passes the server object and the object decoded from the JSON data to your procedure (method).
129
130Takes your returned value (scalar or arrayref or hashref).
131
132Sends a response.
133
134Well, you write your procedure code only.
135
136
137=head1 METHODS
138
139They are inherited from the L<JSON::RPC::Server> methods basically.
140The below methods are implemented in JSON::RPC::Server::CGI.
141
142=over
143
144=item new
145
146Creates new JSON::RPC::Server::CGI object.
147
148=item retrieve_json_from_post
149
150retrieves a JSON request from the body in POST method.
151
152=item retrieve_json_from_get
153
154In the protocol v1.1, 'GET' request method is also allowable.
155it retrieves a JSON request from the query string in GET method.
156
157=item response
158
159returns a response JSON data to a client.
160
161=item cgi
162
163returns the L<CGI> object.
164
165=back
166
167=head1 SEE ALSO
168
169L<JSON::RPC::Server>,
170
171L<JSON::RPC::Procedure>,
172
173L<JSON>,
174
175L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>,
176
177L<http://json-rpc.org/wiki/specification>,
178
179=head1 AUTHOR
180
181Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt>
182
183
184=head1 COPYRIGHT AND LICENSE
185
186Copyright 2007-2008 by Makamaka Hannyaharamitu
187
188This library is free software; you can redistribute it and/or modify
189it under the same terms as Perl itself.
190
191=cut
192