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