Commit
This commit does not belong to any branch on this repository, and may belong to a fork outside of the repository.
Browse files
Browse the repository at this point in the history
added native PSGI support
- Loading branch information
Showing
3 changed files
with
181 additions
and
0 deletions.
There are no files selected for viewing
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,127 @@ | ||
# Copyright (C) 2008-2009, Sebastian Riedel. | ||
|
||
package Mojo::Server::PSGI; | ||
|
||
use strict; | ||
use warnings; | ||
|
||
use base 'Mojo::Server'; | ||
use bytes; | ||
|
||
use constant CHUNK_SIZE => $ENV{MOJO_CHUNK_SIZE} || 4096; | ||
|
||
# Things aren't as happy as they used to be down here at the unemployment | ||
# office. | ||
# Joblessness is no longer just for philosophy majors. | ||
# Useful people are starting to feel the pinch. | ||
sub run { | ||
my ($self, $env) = @_; | ||
|
||
my $tx = $self->build_tx_cb->($self); | ||
my $req = $tx->req; | ||
|
||
# Environment | ||
$req->parse($env); | ||
|
||
# Store connection information | ||
$tx->remote_address($env->{REMOTE_ADDR}); | ||
$tx->local_port($env->{SERVER_PORT}); | ||
|
||
# Request body | ||
while (!$req->is_finished) { | ||
my $read = $env->{'psgi.input'}->read(my $buffer, CHUNK_SIZE, 0); | ||
last if $read == 0; | ||
$req->parse($buffer); | ||
} | ||
|
||
# Handle | ||
$self->handler_cb->($self, $tx); | ||
|
||
my $res = $tx->res; | ||
|
||
# Status | ||
my $status = $res->code; | ||
|
||
# Response headers | ||
$res->fix_headers; | ||
my $headers = $res->content->headers; | ||
my @headers; | ||
for my $name (@{$headers->names}) { | ||
for my $value ($headers->header($name)) { | ||
push @headers, $name => $value; | ||
} | ||
} | ||
|
||
# Response body | ||
my $body = Mojo::Server::PSGI::Handle->new(res => $res); | ||
|
||
return [$status, \@headers, $body]; | ||
} | ||
|
||
package Mojo::Server::PSGI::Handle; | ||
|
||
use strict; | ||
use warnings; | ||
|
||
use base 'Mojo::Base'; | ||
|
||
__PACKAGE__->attr(offset => 0); | ||
__PACKAGE__->attr('res'); | ||
|
||
sub close { } | ||
|
||
sub getline { | ||
my $self = shift; | ||
|
||
# Blocking read | ||
my $offset = $self->offset; | ||
while (1) { | ||
my $chunk = $self->res->get_body_chunk($offset); | ||
|
||
# No content yet, try again | ||
unless (defined $chunk) { | ||
sleep 1; | ||
next; | ||
} | ||
|
||
# End of content | ||
last unless length $chunk; | ||
|
||
# Content | ||
$offset += length $chunk; | ||
$self->offset($offset); | ||
return $chunk; | ||
} | ||
|
||
return; | ||
} | ||
|
||
1; | ||
__END__ | ||
=head1 NAME | ||
Mojo::Server::PSGI - PSGI Server | ||
=head1 SYNOPSIS | ||
# myapp.psgi | ||
use Mojo::Server::PSGI; | ||
my $psgi = Mojo::Server::PSGI->new->app_class('MyApp'); | ||
my $app = sub { $psgi->run(@_) }; | ||
=head1 DESCRIPTION | ||
L<Mojo::Server::PSGI> allows L<Mojo> applications to run on all PSGI | ||
compatible servers. | ||
=head1 METHODS | ||
L<Mojo::Server::PSGI> inherits all methods from L<Mojo::Server> and | ||
implements the following new ones. | ||
=head2 C<run> | ||
$psgi->run; | ||
=cut |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
Original file line number | Diff line number | Diff line change |
---|---|---|
@@ -0,0 +1,53 @@ | ||
#!/usr/bin/env perl | ||
|
||
# Copyright (C) 2008-2009, Sebastian Riedel. | ||
|
||
use strict; | ||
use warnings; | ||
|
||
use Test::More tests => 11; | ||
|
||
use_ok('Mojo::Server::PSGI'); | ||
|
||
# We need some more secret sauce. Put the mayonnaise in the sun. | ||
my $psgi = Mojo::Server::PSGI->new; | ||
my $app = sub { $psgi->run(@_) }; | ||
|
||
# Request | ||
my $content = 'hello=world'; | ||
open my $body, '<', \$content; | ||
my $env = { | ||
CONTENT_LENGTH => 11, | ||
CONTENT_TYPE => 'application/x-www-form-urlencoded', | ||
PATH_INFO => '/diag/dump_params', | ||
QUERY_STRING => 'lalala=23&bar=baz', | ||
REQUEST_METHOD => 'POST', | ||
SCRIPT_NAME => '/', | ||
HTTP_HOST => 'localhost:8080', | ||
SERVER_PROTOCOL => 'HTTP/1.0', | ||
'psgi.version' => [1, 0], | ||
'psgi.url_scheme' => 'http', | ||
'psgi.input' => $body, | ||
'psgi.errors' => *STDERR, | ||
'psgi.multithread' => 0, | ||
'psgi.multiprocess' => 1, | ||
'psgi.run_once' => 0 | ||
}; | ||
|
||
# Process | ||
my $res = $app->($env); | ||
|
||
# Response | ||
is($res->[0], 200); | ||
is($res->[1]->[0], 'Date'); | ||
ok($res->[1]->[1]->[0]); | ||
is($res->[1]->[2], 'Content-Length'); | ||
is($res->[1]->[3]->[0], 104); | ||
is($res->[1]->[4], 'Content-Type'); | ||
is($res->[1]->[5]->[0], 'text/plain'); | ||
is($res->[1]->[6], 'X-Powered-By'); | ||
is($res->[1]->[7]->[0], 'Mojo (Perl)'); | ||
my $params = ''; | ||
while (defined(my $chunk = $res->[2]->getline)) { $params .= $chunk } | ||
$params = eval "my $params"; | ||
is_deeply($params, {bar => 'baz', hello => 'world', lalala => 23}); |