line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Perinci::Access::Simple::Server::Pipe; |
2
|
|
|
|
|
|
|
|
3
|
|
|
|
|
|
|
our $DATE = '2017-07-28'; # DATE |
4
|
|
|
|
|
|
|
our $VERSION = '0.26'; # VERSION |
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
174692
|
use 5.010001; |
|
1
|
|
|
|
|
6
|
|
7
|
1
|
|
|
1
|
|
10
|
use strict; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
32
|
|
8
|
1
|
|
|
1
|
|
7
|
use warnings; |
|
1
|
|
|
|
|
4
|
|
|
1
|
|
|
|
|
38
|
|
9
|
1
|
|
|
1
|
|
8
|
use Log::ger; |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
8
|
|
10
|
|
|
|
|
|
|
|
11
|
1
|
|
|
1
|
|
912
|
use Data::Clean::FromJSON; |
|
1
|
|
|
|
|
4199
|
|
|
1
|
|
|
|
|
39
|
|
12
|
1
|
|
|
1
|
|
635
|
use Data::Clean::JSON; |
|
1
|
|
|
|
|
568
|
|
|
1
|
|
|
|
|
67
|
|
13
|
1
|
|
|
1
|
|
651
|
use JSON::MaybeXS; |
|
1
|
|
|
|
|
6732
|
|
|
1
|
|
|
|
|
89
|
|
14
|
1
|
|
|
1
|
|
12
|
use Perinci::AccessUtil qw(insert_riap_stuffs_to_res decode_args_in_riap_req); |
|
1
|
|
|
|
|
3
|
|
|
1
|
|
|
|
|
70
|
|
15
|
|
|
|
|
|
|
|
16
|
1
|
|
|
1
|
|
629
|
use Moo; |
|
1
|
|
|
|
|
14469
|
|
|
1
|
|
|
|
|
18
|
|
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
has req => (is => 'rw'); # current Riap request |
19
|
|
|
|
|
|
|
has res => (is => 'rw'); # current Riap response |
20
|
|
|
|
|
|
|
has riap_client => ( |
21
|
|
|
|
|
|
|
is => 'rw', |
22
|
|
|
|
|
|
|
lazy => 1, |
23
|
|
|
|
|
|
|
default => sub { |
24
|
|
|
|
|
|
|
require Perinci::Access::Schemeless; |
25
|
|
|
|
|
|
|
Perinci::Access::Schemeless->new(); |
26
|
|
|
|
|
|
|
}); |
27
|
|
|
|
|
|
|
|
28
|
|
|
|
|
|
|
my $json = JSON::MaybeXS->new->allow_nonref->canonical; |
29
|
|
|
|
|
|
|
my $cleanser = Data::Clean::JSON->get_cleanser; |
30
|
|
|
|
|
|
|
my $cleanserfj = Data::Clean::FromJSON->get_cleanser; |
31
|
|
|
|
|
|
|
|
32
|
|
|
|
|
|
|
$|++; |
33
|
|
|
|
|
|
|
|
34
|
|
|
|
|
|
|
# default handler |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub handle { |
37
|
1
|
|
|
1
|
1
|
392534
|
my ($self) = @_; |
38
|
1
|
|
|
|
|
11
|
my $req = $self->req; |
39
|
|
|
|
|
|
|
|
40
|
1
|
|
|
|
|
36
|
my $res = $self->riap_client->request($req->{action} => $req->{uri}, $req); |
41
|
1
|
|
|
|
|
186068
|
$self->res($res); |
42
|
|
|
|
|
|
|
} |
43
|
|
|
|
|
|
|
|
44
|
|
|
|
|
|
|
sub send_response { |
45
|
1
|
|
|
1
|
1
|
1992
|
my $self = shift; |
46
|
1
|
|
50
|
|
|
10
|
my $res = $self->res // [500, "BUG: Response not set"]; |
47
|
1
|
|
|
|
|
8
|
log_trace("Sending response to stdout: %s", $res); |
48
|
1
|
50
|
50
|
|
|
15
|
my $v = ($self->req ? $self->req->{v} : undef) // 1.1; |
49
|
1
|
|
|
|
|
8
|
insert_riap_stuffs_to_res($res, $v); |
50
|
1
|
|
|
|
|
66
|
$res = $cleanser->clone_and_clean($res); |
51
|
1
|
|
|
|
|
322
|
print "j", $json->encode($res), "\015\012"; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
sub run { |
55
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
56
|
0
|
|
|
|
|
|
my $last; |
57
|
|
|
|
|
|
|
|
58
|
0
|
|
|
|
|
|
log_trace("Starting loop ..."); |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
REQ: |
61
|
0
|
|
|
|
|
|
while (1) { |
62
|
0
|
|
|
|
|
|
my $line = <STDIN>; |
63
|
0
|
|
|
|
|
|
log_trace("Read line from stdin: %s", $line); |
64
|
0
|
0
|
|
|
|
|
last REQ unless defined($line); |
65
|
0
|
|
|
|
|
|
my $req_json; |
66
|
0
|
0
|
|
|
|
|
if ($line =~ /\Aj(.*)/) { |
67
|
0
|
|
|
|
|
|
$req_json = $1; |
68
|
|
|
|
|
|
|
} else { |
69
|
0
|
|
|
|
|
|
$self->res([400, "Invalid request line, use j<json>"]); |
70
|
0
|
|
|
|
|
|
$last++; |
71
|
0
|
|
|
|
|
|
goto RES; |
72
|
|
|
|
|
|
|
} |
73
|
0
|
|
|
|
|
|
log_trace("Read JSON from stdin: %s", $req_json); |
74
|
0
|
|
|
|
|
|
my $req; |
75
|
0
|
|
|
|
|
|
eval { |
76
|
0
|
|
|
|
|
|
$req = $json->decode($req_json); |
77
|
0
|
|
|
|
|
|
$cleanserfj->clean_in_place($req); |
78
|
0
|
|
|
|
|
|
decode_args_in_riap_req($req); |
79
|
|
|
|
|
|
|
}; |
80
|
0
|
|
|
|
|
|
my $e = $@; |
81
|
0
|
0
|
|
|
|
|
if ($e) { |
|
|
0
|
|
|
|
|
|
82
|
|
|
|
|
|
|
#$self->res([400, "Invalid JSON ($e)"]); |
83
|
0
|
|
|
|
|
|
$self->res([400, "Invalid JSON"]); |
84
|
0
|
|
|
|
|
|
goto RES; |
85
|
|
|
|
|
|
|
} elsif (ref($req) ne 'HASH') { |
86
|
0
|
|
|
|
|
|
$self->res([400, "Invalid request (not hash)"]); |
87
|
0
|
|
|
|
|
|
goto RES; |
88
|
|
|
|
|
|
|
} |
89
|
0
|
|
|
|
|
|
$self->req($req); |
90
|
|
|
|
|
|
|
|
91
|
0
|
|
|
|
|
|
HANDLE: |
92
|
|
|
|
|
|
|
$self->handle; |
93
|
|
|
|
|
|
|
|
94
|
0
|
|
|
|
|
|
RES: |
95
|
|
|
|
|
|
|
$self->send_response; |
96
|
|
|
|
|
|
|
|
97
|
0
|
0
|
|
|
|
|
last if $last; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
} |
100
|
|
|
|
|
|
|
|
101
|
|
|
|
|
|
|
1; |
102
|
|
|
|
|
|
|
# ABSTRACT: (Base) class for creating Riap::Simple server over pipe |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
__END__ |
105
|
|
|
|
|
|
|
|
106
|
|
|
|
|
|
|
=pod |
107
|
|
|
|
|
|
|
|
108
|
|
|
|
|
|
|
=encoding UTF-8 |
109
|
|
|
|
|
|
|
|
110
|
|
|
|
|
|
|
=head1 NAME |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
Perinci::Access::Simple::Server::Pipe - (Base) class for creating Riap::Simple server over pipe |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
=head1 VERSION |
115
|
|
|
|
|
|
|
|
116
|
|
|
|
|
|
|
This document describes version 0.26 of Perinci::Access::Simple::Server::Pipe (from Perl distribution Perinci-Access-Simple-Server), released on 2017-07-28. |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
=head1 SYNOPSIS |
119
|
|
|
|
|
|
|
|
120
|
|
|
|
|
|
|
In C</path/to/your/program>: |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
#!/usr/bin/perl |
123
|
|
|
|
|
|
|
package MyRiapServer; |
124
|
|
|
|
|
|
|
use Moo; |
125
|
|
|
|
|
|
|
extends 'Perinci::Access::Simple::Server::Pipe'; |
126
|
|
|
|
|
|
|
|
127
|
|
|
|
|
|
|
# override some methods ... |
128
|
|
|
|
|
|
|
|
129
|
|
|
|
|
|
|
package main; |
130
|
|
|
|
|
|
|
MyRiapServer->run; |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
Accessing the server via L<Perinci::Access>: |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
% perl -MPerinci::Access -e'my $pa = Perinci::Access->new; |
135
|
|
|
|
|
|
|
my $res = $pa->request(call => "riap+pipe:/path/to/your/prog////Foo/func"); |
136
|
|
|
|
|
|
|
|
137
|
|
|
|
|
|
|
=head1 DESCRIPTION |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
This module is a class for creating L<Riap::Simple> server over pipe. Riap |
140
|
|
|
|
|
|
|
requests will be read from STDIN, and response sent to STDOUT. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
By default, the L<handle()> method processes the Riap request using |
143
|
|
|
|
|
|
|
L<Perinci::Access::Schemeless>. You can customize this by overriding the method. |
144
|
|
|
|
|
|
|
The Riap request is in C<req>. Method should set C<res> to the Riap response. |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
147
|
|
|
|
|
|
|
|
148
|
|
|
|
|
|
|
=head2 req => HASH |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
The current Riap request. |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
=head2 res => HASH |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
The current Riap response. |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
=head1 METHODS |
157
|
|
|
|
|
|
|
|
158
|
|
|
|
|
|
|
=for Pod::Coverage BUILD |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
=head2 run() |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
The main method. Will start a loop of reading request from STDIN and sending |
163
|
|
|
|
|
|
|
response to STDOUT. Riap request will be put to C<req> attribute. |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
=head2 handle() |
166
|
|
|
|
|
|
|
|
167
|
|
|
|
|
|
|
The method that will be called by run() to set C<res> attribute. By default it |
168
|
|
|
|
|
|
|
will pass the request to L<Perinci::Access::Schemeless>. You can override this |
169
|
|
|
|
|
|
|
method to provide custom behavior. |
170
|
|
|
|
|
|
|
|
171
|
|
|
|
|
|
|
=head2 send_response() |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
The method that sends C<res> to client (STDOUT). |
174
|
|
|
|
|
|
|
|
175
|
|
|
|
|
|
|
=head1 HOMEPAGE |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
Please visit the project's homepage at L<https://metacpan.org/release/Perinci-Access-Simple-Server>. |
178
|
|
|
|
|
|
|
|
179
|
|
|
|
|
|
|
=head1 SOURCE |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
Source repository is at L<https://github.com/perlancar/perl-Perinci-Access-Simple-Server>. |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
=head1 BUGS |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
Please report any bugs or feature requests on the bugtracker website L<https://rt.cpan.org/Public/Dist/Display.html?Name=Perinci-Access-Simple-Server> |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
When submitting a bug or request, please include a test-file or a |
188
|
|
|
|
|
|
|
patch to an existing test-file that illustrates the bug or desired |
189
|
|
|
|
|
|
|
feature. |
190
|
|
|
|
|
|
|
|
191
|
|
|
|
|
|
|
=head1 SEE ALSO |
192
|
|
|
|
|
|
|
|
193
|
|
|
|
|
|
|
L<Riap::Simple>, L<Riap>, L<Rinci> |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
L<Perinci::Access::Simple::Server::Socket>. |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
=head1 AUTHOR |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
perlancar <perlancar@cpan.org> |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
=head1 COPYRIGHT AND LICENSE |
202
|
|
|
|
|
|
|
|
203
|
|
|
|
|
|
|
This software is copyright (c) 2017, 2015, 2014, 2013, 2012 by perlancar@cpan.org. |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
This is free software; you can redistribute it and/or modify it under |
206
|
|
|
|
|
|
|
the same terms as the Perl 5 programming language system itself. |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
=cut |