1############################################################################## 2package JSON::RPC::Server::Apache2; 3 4use strict; 5 6use lib qw(/var/www/cgi-bin/json/); 7use base qw(JSON::RPC::Server); 8 9use Apache2::Const -compile => qw(OK HTTP_BAD_REQUEST SERVER_ERROR); 10 11use APR::Table (); 12use Apache2::RequestRec (); 13use Apache2::RequestIO (); 14use Apache2::RequestUtil (); 15 16 17$JSON::RPC::Server::Apache::VERSION = '0.05'; 18 19 20sub handler { 21 my($r) = @_; 22 23 my $s = __PACKAGE__->new; 24 25 $s->request($r); 26 27 $s->{path_info} = $r->path_info; 28 29 my @modules = $r->dir_config('dispatch') || $r->dir_config('dispatch_to'); 30 31 $s->return_die_message( $r->dir_config('return_die_message') ); 32 33 $s->dispatch([@modules]); 34 35 $s->handle(@_); 36 37 Apache2::Const::OK; 38} 39 40 41sub new { 42 my $class = shift; 43 return $class->SUPER::new(); 44} 45 46 47sub retrieve_json_from_post { 48 my $self = shift; 49 my $r = $self->request; 50 my $len = $r->headers_in()->get('Content-Length'); 51 52 return if($r->method ne 'POST'); 53 return if($len > $self->max_length); 54 55 my ($buf, $content); 56 57 while( $r->read($buf,$len) ){ 58 $content .= $buf; 59 } 60 61 $content; 62} 63 64 65sub retrieve_json_from_get { 66 my $self = shift; 67 my $r = $self->request; 68 my $args = $r->args; 69 70 $args = '' if (!defined $args); 71 72 $self->{path_info} = $r->path_info; 73 74 my $params = {}; 75 76 $self->version(1.1); 77 78 for my $pair (split/&/, $args) { 79 my ($key, $value) = split/=/, $pair; 80 if ( defined ( my $val = $params->{ $key } ) ) { 81 if ( ref $val ) { 82 push @{ $params->{ $key } }, $value; 83 } 84 else { # change a scalar into an arrayref 85 $params->{ $key } = []; 86 push @{ $params->{ $key } }, $val, $value; 87 } 88 } 89 else { 90 $params->{ $key } = $value; 91 } 92 } 93 94 my $method = $r->path_info; 95 96 $method =~ s{^.*/}{}; 97 $self->{path_info} =~ s{/?[^/]+$}{}; 98 99 $self->json->encode({ 100 version => '1.1', 101 method => $method, 102 params => $params, 103 }); 104} 105 106 107sub response { 108 my ($self, $response) = @_; 109 my $r = $self->request; 110 111 $r->content_type($self->content_type); 112 $r->print($response->content); 113 114 return ($response->code == 200) 115 ? Apache2::Const::OK : Apache2::Const::SERVER_ERROR; 116} 117 118 119 1201; 121__END__ 122 123 124=pod 125 126 127=head1 NAME 128 129JSON::RPC::Server::Apache2 - JSON-RPC sever for mod_perl2 130 131=head1 SYNOPSIS 132 133 # In apache conf 134 135 PerlRequire /your/path/start.pl 136 PerlModule MyApp 137 138 <Location /jsonrpc/API> 139 SetHandler perl-script 140 PerlResponseHandler JSON::RPC::Server::Apache 141 PerlSetVar dispatch "MyApp" 142 PerlSetVar return_die_message 0 143 </Location> 144 145 #-------------------------- 146 # In your application class 147 package MyApp; 148 149 use base qw(JSON::RPC::Procedure); # Perl 5.6 or more than 150 151 sub echo : Public { # new version style. called by clients 152 # first argument is JSON::RPC::Server object. 153 return $_[1]; 154 } 155 156 sub sum : Public(a:num, b:num) { # sets value into object member a, b. 157 my ($s, $obj) = @_; 158 # return a scalar value or a hashref or an arryaref. 159 return $obj->{a} + $obj->{b}; 160 } 161 162 sub a_private_method : Private { 163 # ... can't be called by client 164 } 165 166 sub sum_old_style { # old version style. taken as Public 167 my ($s, @arg) = @_; 168 return $arg[0] + $arg[1]; 169 } 170 171=head1 DESCRIPTION 172 173Gets a client request. 174 175Parses its JSON data. 176 177Passes the server object and the object decoded from the JSON data to your procedure (method). 178 179Takes your returned value (scalar or arrayref or hashref). 180 181Sends a response. 182 183Well, you write your procedure code only. 184 185 186=head1 METHODS 187 188They are inherited from the L<JSON::RPC::Server> methods basically. 189The below methods are implemented in JSON::RPC::Server::Apache2. 190 191=over 192 193=item new 194 195Creates new JSON::RPC::Server::Apache2 object. 196 197=item handle 198 199Runs server object and returns a response. 200 201=item retrieve_json_from_post 202 203retrieves a JSON request from the body in POST method. 204 205=item retrieve_json_from_get 206 207In the protocol v1.1, 'GET' request method is also allowable. 208it retrieves a JSON request from the query string in GET method. 209 210=item response 211 212returns a response JSON data to a client. 213 214=back 215 216=head1 SEE ALSO 217 218L<JSON::RPC::Server>, 219 220L<JSON::RPC::Procedure>, 221 222L<JSON>, 223 224L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>, 225 226L<http://json-rpc.org/wiki/specification>, 227 228=head1 AUTHOR 229 230Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 231 232 233=head1 COPYRIGHT AND LICENSE 234 235Copyright 2007-2008 by Makamaka Hannyaharamitu 236 237This library is free software; you can redistribute it and/or modify 238it under the same terms as Perl itself. 239 240=cut 241 242 243