File Coverage

blib/lib/Plack/Server/Coro.pm
Criterion Covered Total %
statement 12 18 66.6
branch n/a
condition 0 2 0.0
subroutine 4 6 66.6
pod n/a
total 16 26 61.5


line stmt bran cond sub pod time code
1             package Plack::Server::Coro;
2 1     1   7 use strict;
  1         2  
  1         44  
3 1     1   25 use 5.008_001;
  1         3  
  1         66  
4             our $VERSION = "0.02";
5              
6 1     1   1027 use Plack::Util;
  1         24484  
  1         148  
7              
8             sub new {
9 0     0     my $class = shift;
10 0           bless { @_ }, $class;
11             }
12              
13             sub run {
14 0     0     my($self, $app) = @_;
15              
16 0   0       my $server = Plack::Server::Coro::Server->new(host => $self->{host} || '*');
17 0           $server->{app} = $app;
18 0           $server->run(port => $self->{port});
19             }
20              
21              
22             package Plack::Server::Coro::Server;
23 1     1   11 use base qw( Net::Server::Coro );
  1         3  
  1         998  
24              
25             our $HasAIO = !$ENV{PLACK_NO_SENDFILE} && eval "use Coro::AIO; 1";
26              
27             use HTTP::Status;
28             use Scalar::Util;
29             use List::Util qw(sum max);
30             use Plack::HTTPParser qw( parse_http_request );
31             use constant MAX_REQUEST_SIZE => 131072;
32              
33             sub process_request {
34             my $self = shift;
35              
36             my $fh = $self->{server}{client};
37              
38             my $env = {
39             SERVER_PORT => $self->{server}{port}[0],
40             SERVER_NAME => $self->{server}{host}[0],
41             SCRIPT_NAME => '',
42             REMOTE_ADDR => $self->{server}{peeraddr},
43             'psgi.version' => [ 1, 0 ],
44             'psgi.errors' => *STDERR,
45             'psgi.input' => $self->{server}{client},
46             'psgi.url_scheme' => 'http', # SSL support?
47             'psgi.nonblocking' => Plack::Util::TRUE,
48             'psgi.run_once' => Plack::Util::FALSE,
49             'psgi.multithread' => Plack::Util::TRUE,
50             'psgi.multiprocess' => Plack::Util::FALSE,
51             'psgi.streaming' => Plack::Util::TRUE,
52             };
53              
54             my $res = [ 400, [ 'Content-Type' => 'text/plain' ], [ 'Bad Request' ] ];
55              
56             my $buf = '';
57             while (1) {
58             my $read = $fh->readline("\015\012\015\012")
59             or last;
60             $buf .= $read;
61              
62             my $reqlen = parse_http_request($buf, $env);
63             if ($reqlen >= 0) {
64             $res = Plack::Util::run_app $self->{app}, $env;
65             last;
66             } elsif ($reqlen == -2) {
67             # incomplete, continue
68             } else {
69             last;
70             }
71             }
72              
73             if (ref $res eq 'ARRAY') {
74             # PSGI standard
75             $self->_write_response($res, $fh);
76             } elsif (ref $res eq 'CODE') {
77             # delayed return
78             my $cb = Coro::rouse_cb;
79             $res->(sub {
80             $self->_write_response(shift, $fh, $cb);
81             });
82             Coro::rouse_wait $cb;
83             }
84             }
85              
86             sub _write_response {
87             my($self, $res, $fh, $rouse_cb) = @_;
88              
89             my (@lines, $conn_value);
90              
91             while (my ($k, $v) = splice(@{$res->[1]}, 0, 2)) {
92             push @lines, "$k: $v\015\012";
93             if (lc $k eq 'connection') {
94             $conn_value = $v;
95             }
96             }
97              
98             unshift @lines, "HTTP/1.0 $res->[0] @{[ HTTP::Status::status_message($res->[0]) ]}\015\012";
99             push @lines, "\015\012";
100              
101             $fh->syswrite(join '', @lines);
102              
103             if (!defined $res->[2]) {
104             # streaming write
105             return Plack::Util::inline_object
106             write => sub { $fh->syswrite(join '', @_) },
107             close => $rouse_cb;
108             } elsif ($HasAIO && Plack::Util::is_real_fh($res->[2])) {
109             my $length = -s $res->[2];
110             my $offset = 0;
111             while (1) {
112             my $sent = aio_sendfile( $fh->fh, $res->[2], $offset, $length - $offset );
113             $offset += $sent if $sent > 0;
114             last if $offset >= $length;
115             }
116             } else {
117             Plack::Util::foreach($res->[2], sub { $fh->syswrite(join '', @_) });
118             }
119              
120             $rouse_cb->() if $rouse_cb;
121             }
122              
123             package Plack::Server::Coro;
124              
125             1;
126              
127             __END__