File Coverage

blib/lib/Mojo/Server/PSGI.pm
Criterion Covered Total %
statement 37 37 100.0
branch 8 12 66.6
condition 4 7 57.1
subroutine 7 7 100.0
pod 2 2 100.0
total 58 65 89.2


line stmt bran cond sub pod time code
1             package Mojo::Server::PSGI;
2 2     2   518 use Mojo::Base 'Mojo::Server';
  2         3  
  2         14  
3              
4             sub run {
5 6     6 1 15 my ($self, $env) = @_;
6              
7 6         30 my $tx = $self->build_tx;
8 6         23 my $req = $tx->req->parse($env);
9 6         35 $tx->local_port($env->{SERVER_PORT})->remote_address($env->{REMOTE_ADDR});
10              
11             # Request body (may block if we try to read too much)
12 6         16 my $len = $env->{CONTENT_LENGTH};
13 6         18 until ($req->is_finished) {
14 2 50 33     12 my $chunk = ($len && $len < 131072) ? $len : 131072;
15 2 50       17 last unless my $read = $env->{'psgi.input'}->read(my $buffer, $chunk, 0);
16 2         26 $req->parse($buffer);
17 2 50       8 last if ($len -= $read) <= 0;
18             }
19              
20 6         35 $self->emit(request => $tx);
21              
22             # Response headers
23 6         16 my $res = $tx->res->fix_headers;
24 6         19 my $hash = $res->headers->to_hash(1);
25 6         12 my @headers;
26 6         22 for my $name (keys %$hash) { push @headers, $name, $_ for @{$hash->{$name}} }
  19         25  
  19         59  
27              
28             # PSGI response
29 6         27 my $io = Mojo::Server::PSGI::_IO->new(tx => $tx, empty => $tx->is_empty);
30 6   50     30 return [$res->code // 404, \@headers, $io];
31             }
32              
33             sub to_psgi_app {
34 10     10 1 22 my $self = shift;
35              
36             # Preload application and wrap it
37 10         38 $self->app->server($self);
38 6     6   1036 return sub { $self->run(@_) }
39 10         106 }
40              
41             package Mojo::Server::PSGI::_IO;
42 2     2   16 use Mojo::Base -base;
  2         6  
  2         34  
43              
44             # Finish transaction
45 5     5   3712 sub close { shift->{tx}->closed }
46              
47             sub getline {
48 9     9   10495 my $self = shift;
49              
50             # Empty
51 9 100       35 return undef if $self->{empty};
52              
53             # No content yet, try again later
54 8   100     27 my $chunk = $self->{tx}->res->get_body_chunk($self->{offset} //= 0);
55 8 50       23 return '' unless defined $chunk;
56              
57             # End of content
58 8 100       23 return undef unless length $chunk;
59              
60 4         11 $self->{offset} += length $chunk;
61 4         11 return $chunk;
62             }
63              
64             1;
65              
66             =encoding utf8
67              
68             =head1 NAME
69              
70             Mojo::Server::PSGI - PSGI server
71              
72             =head1 SYNOPSIS
73              
74             use Mojo::Server::PSGI;
75              
76             my $psgi = Mojo::Server::PSGI->new;
77             $psgi->unsubscribe('request')->on(request => sub {
78             my ($psgi, $tx) = @_;
79              
80             # Request
81             my $method = $tx->req->method;
82             my $path = $tx->req->url->path;
83              
84             # Response
85             $tx->res->code(200);
86             $tx->res->headers->content_type('text/plain');
87             $tx->res->body("$method request for $path!");
88              
89             # Resume transaction
90             $tx->resume;
91             });
92             my $app = $psgi->to_psgi_app;
93              
94             =head1 DESCRIPTION
95              
96             L allows L applications to run on all L
97             compatible servers.
98              
99             See L for more.
100              
101             =head1 EVENTS
102              
103             L inherits all events from L.
104              
105             =head1 ATTRIBUTES
106              
107             L inherits all attributes from L.
108              
109             =head1 METHODS
110              
111             L inherits all methods from L and implements
112             the following new ones.
113              
114             =head2 run
115              
116             my $res = $psgi->run($env);
117              
118             Run L.
119              
120             =head2 to_psgi_app
121              
122             my $app = $psgi->to_psgi_app;
123              
124             Turn L application into L application.
125              
126             =head1 SEE ALSO
127              
128             L, L, L.
129              
130             =cut