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

package Mojo::Server::PSGI;
use Mojo::Base 'Mojo::Server';

sub run {
  my ($self, $env) = @_;

  my $tx  = $self->build_tx;
  my $req = $tx->req->parse($env);
  $tx->local_port($env->{SERVER_PORT})->remote_address($env->{REMOTE_ADDR});

  # Request body (may block if we try to read too much)
  my $len = $env->{CONTENT_LENGTH};
  until ($req->is_finished) {
    my $chunk = ($len && $len < 131072) ? $len : 131072;
    last unless my $read = $env->{'psgi.input'}->read(my $buffer, $chunk, 0);
    $req->parse($buffer);
    last if ($len -= $read) <= 0;
  }

  $self->emit(request => $tx);

  # Response headers
  my $res  = $tx->res->fix_headers;
  my $hash = $res->headers->to_hash(1);
  my @headers;
  for my $name (keys %$hash) { push @headers, $name, $_ for @{$hash->{$name}} }

  # PSGI response
  my $io = Mojo::Server::PSGI::_IO->new(tx => $tx, empty => $tx->is_empty);
  return [$res->code // 404, \@headers, $io];
}

sub to_psgi_app {
  my $self = shift;

  # Preload application and wrap it
  $self->app->server($self);
  return sub { $self->run(@_) }
}

package Mojo::Server::PSGI::_IO;
use Mojo::Base -base;

# Finish transaction
sub close { shift->{tx}->closed }

sub getline {
  my $self = shift;

  # Empty
  return undef if $self->{empty};

  # No content yet, try again later
  my $chunk = $self->{tx}->res->get_body_chunk($self->{offset} //= 0);
  return '' unless defined $chunk;

  # End of content
  return undef unless length $chunk;

  $self->{offset} += length $chunk;
  return $chunk;
}

1;

=encoding utf8

=head1 NAME

Mojo::Server::PSGI - PSGI server

=head1 SYNOPSIS

  use Mojo::Server::PSGI;

  my $psgi = Mojo::Server::PSGI->new;
  $psgi->unsubscribe('request')->on(request => sub ($psgi, $tx) {

    # Request
    my $method = $tx->req->method;
    my $path   = $tx->req->url->path;

    # Response
    $tx->res->code(200);
    $tx->res->headers->content_type('text/plain');
    $tx->res->body("$method request for $path!");

    # Resume transaction
    $tx->resume;
  });
  my $app = $psgi->to_psgi_app;

=head1 DESCRIPTION

L allows L applications to run on all L compatible servers.

See L for more.

=head1 EVENTS

L inherits all events from L.

=head1 ATTRIBUTES

L inherits all attributes from L.

=head1 METHODS

L inherits all methods from L and implements the following new ones.

=head2 run

  my $res = $psgi->run($env);

Run L.

=head2 to_psgi_app

  my $app = $psgi->to_psgi_app;

Turn L application into L application.

=head1 SEE ALSO

L, L, L.

=cut