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