File Coverage

blib/lib/RPC/Any/Interface/PSGI.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package RPC::Any::Interface::PSGI;
2              
3 1     1   24508 use strict;
  1         3  
  1         45  
4 1     1   7 use warnings;
  1         2  
  1         32  
5 1     1   31 use 5.008001;
  1         10  
  1         73  
6             our $VERSION = '0.03';
7              
8 1     1   1306 use Moose::Role;
  0            
  0            
9             use HTTP::Request;
10             use Plack::Request;
11              
12             has _plack_req => (is => 'rw', isa => 'Plack::Request');
13              
14             around 'get_input' => sub {
15             my $orig = shift;
16             my $self = shift;
17             my $env = shift;
18              
19             $self->_plack_req(Plack::Request->new($env));
20             return $self->_plack_req->content;
21             };
22              
23             around 'input_to_request' => sub {
24             my $orig = shift;
25             my $self = shift;
26             my $input = shift;
27              
28             my $request = HTTP::Request->new($self->_plack_req->method, $self->_plack_req->request_uri, $self->_plack_req->headers);
29             $request->protocol($self->_plack_req->protocol);
30             $request->content_type($self->_plack_req->content_type);
31             $request->content_length($self->_plack_req->content_length);
32              
33             if (utf8::is_utf8($input)) {
34             utf8::encode($input);
35             $self->_set_request_utf8($request);
36             }
37             $request->content($input);
38              
39             return $request;
40             };
41              
42             # HTTP role doesn't allow me to get headers and content seperately
43             # so I copied the header processing
44             around 'produce_output' => sub {
45             my $orig = shift;
46             my $self = shift;
47             my $response = shift;
48              
49             my %headers = %{ $self->_output_headers };
50             $response->header(%headers) if %headers;
51              
52             my @headers;
53             $response->headers->scan(sub { push @headers, @_ });
54              
55             return [ $response->code, [ @headers ], [ $response->content ] ];
56             };
57              
58             1;
59              
60             __END__
61              
62             =head1 NAME
63              
64             RPC::Any::Interface::PSGI - PSGI interface for RPC::Any
65              
66             =head1 SYNOPSIS
67              
68             # in app.psgi
69             use RPC::Any::Server::JSONRPC::PSGI;
70              
71             # Create a server where calling Foo.bar will call My::Module->bar.
72             my $server = RPC::Any::Server::JSONRPC::PSGI->new(
73             dispatch => { 'Foo' => 'My::Module' },
74             allow_get => 0,
75             );
76              
77             my $handler = sub{ $server->handle_input(@_) };
78              
79             =head1 DESCRIPTION
80              
81             RPC::Any::Interface::PSGI is a PSGI interface for RPC::Any. It is based
82             on RPC::Any::Interface::CGI and allows you to run RPC::Any::Server
83             subclasses on any web servers that support PSGI.
84              
85             This module cannot be used directly. You must use RPC::Any::Server
86             subclasses that consume this module such as
87             RPC::Any::Server::JSONRPC::PSGI and RPC::Any::Server::XMLRPC::PSGI.
88              
89             =head1 AUTHOR
90              
91             Sherwin Daganato E<lt>sherwin@daganato.comE<gt>
92              
93             =head1 LICENSE
94              
95             This library is free software; you can redistribute it and/or modify
96             it under the same terms as Perl itself.
97              
98             =head1 SEE ALSO
99              
100             L<RPC::Any> L<Plack> L<PSGI>
101              
102             =cut