1##############################################################################
2package JSON::RPC::Server::Daemon;
3
4use strict;
5use JSON::RPC::Server; # for old Perl 5.005
6use base qw(JSON::RPC::Server);
7
8$JSON::RPC::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::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::Server::Daemon;
79
80 JSON::RPC::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::Procedure); # Perl 5.6 or more than
89
90 sub echo : Public {    # new version style. called by clients
91     # first argument is JSON::RPC::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::Server> methods basically.
117The below methods are implemented in JSON::RPC::Server::Daemon.
118
119=over
120
121=item new
122
123Creates new JSON::RPC::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::Server>,
152
153L<JSON::RPC::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