1############################################################################## 2package JSON::RPC::Legacy::Server::Daemon; 3 4use strict; 5use JSON::RPC::Legacy::Server; # for old Perl 5.005 6use base qw(JSON::RPC::Legacy::Server); 7 8$JSON::RPC::Legacy::Server::Daemon::VERSION = '0.03'; 9 10use Data::Dumper; 11 12sub new { 13 my $class = shift; 14 my $self = $class->SUPER::new(); 15 my $pkg; 16 17 if( grep { $_ =~ /^SSL_/ } @_ ){ 18 $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon::SSL'; 19 } 20 else{ 21 $self->{_daemon_pkg} = $pkg = 'HTTP::Daemon'; 22 } 23 eval qq| require $pkg; |; 24 if($@){ die $@ } 25 26 $self->{_daemon} ||= $pkg->new(@_) or die; 27 28 return $self; 29} 30 31 32sub handle { 33 my $self = shift; 34 my %opt = @_; 35 my $d = $self->{_daemon} ||= $self->{_daemon_pkg}->new(@_) or die; 36 37 while (my $c = $d->accept) { 38 $self->{con} = $c; 39 while (my $r = $c->get_request) { 40 $self->request($r); 41 $self->path_info($r->url->path); 42 $self->SUPER::handle(); 43 last; 44 } 45 $c->close; 46 } 47 48} 49 50 51sub retrieve_json_from_post { 52 return $_[0]->request->content; 53} 54 55 56sub retrieve_json_from_get { 57} 58 59 60sub response { 61 my ($self, $response) = @_; 62 $self->{con}->send_response($response); 63} 64 651; 66__END__ 67 68 69=head1 NAME 70 71JSON::RPC::Legacy::Server::Daemon - JSON-RPC sever for daemon 72 73=head1 SYNOPSIS 74 75 # Daemon version 76 #-------------------------- 77 # In your daemon server script 78 use JSON::RPC::Legacy::Server::Daemon; 79 80 JSON::RPC::Legacy::Server::Daemon->new(LocalPort => 8080); 81 ->dispatch({'/jsonrpc/API' => 'MyApp'}) 82 ->handle(); 83 84 #-------------------------- 85 # In your application class 86 package MyApp; 87 88 use base qw(JSON::RPC::Legacy::Procedure); # Perl 5.6 or more than 89 90 sub echo : Public { # new version style. called by clients 91 # first argument is JSON::RPC::Legacy::Server object. 92 return $_[1]; 93 } 94 95 sub sum : Public(a:num, b:num) { # sets value into object member a, b. 96 my ($s, $obj) = @_; 97 # return a scalar value or a hashref or an arryaref. 98 return $obj->{a} + $obj->{b}; 99 } 100 101 sub a_private_method : Private { 102 # ... can't be called by client 103 } 104 105 sub sum_old_style { # old version style. taken as Public 106 my ($s, @arg) = @_; 107 return $arg[0] + $arg[1]; 108 } 109 110=head1 DESCRIPTION 111 112This module is for http daemon servers using L<HTTP::Daemon> or L<HTTP::Daemon::SSL>. 113 114=head1 METHODS 115 116They are inherited from the L<JSON::RPC::Legacy::Server> methods basically. 117The below methods are implemented in JSON::RPC::Legacy::Server::Daemon. 118 119=over 120 121=item new 122 123Creates new JSON::RPC::Legacy::Server::Daemon object. 124Arguments are passed to L<HTTP::Daemon> or L<HTTP::Daemon::SSL>. 125 126=item handle 127 128Runs server object and returns a response. 129 130=item retrieve_json_from_post 131 132retrieves a JSON request from the body in POST method. 133 134=item retrieve_json_from_get 135 136In the protocol v1.1, 'GET' request method is also allowable. 137it retrieves a JSON request from the query string in GET method. 138 139=item response 140 141returns a response JSON data to a client. 142 143=back 144 145=head1 SEE ALSO 146 147L<HTTP::Daemon>, 148 149L<HTTP::Daemon::SSL>, 150 151L<JSON::RPC::Legacy::Server>, 152 153L<JSON::RPC::Legacy::Procedure>, 154 155L<JSON>, 156 157L<http://json-rpc.org/wd/JSON-RPC-1-1-WD-20060807.html>, 158 159L<http://json-rpc.org/wiki/specification>, 160 161=head1 AUTHOR 162 163Makamaka Hannyaharamitu, E<lt>makamaka[at]cpan.orgE<gt> 164 165 166=head1 COPYRIGHT AND LICENSE 167 168Copyright 2007-2008 by Makamaka Hannyaharamitu 169 170This library is free software; you can redistribute it and/or modify 171it under the same terms as Perl itself. 172 173=cut 174 175 176