The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Mojolicious::Plugin::MountPSGI::Proxy;
use Mojo::Base 'Mojo';
use Plack::Util;

has 'script';
has 'app';

sub handler {
  my ($self, $c) = @_;
  if(!defined $self->app) {

    $self->app(Plack::Util::load_psgi($self->home->rel_file($self->script)));
  }
  my $name = $c->param('name');
  my $plack_env = _mojo_req_to_psgi_env($c->req);
  $plack_env->{'MOJO.CONTROLLER'} = $c;
  my $plack_res = $self->app->($plack_env);
  my $mojo_res = _psgi_res_to_mojo_res($plack_res);
  $c->tx->res($mojo_res);
  $c->rendered;
}

sub _mojo_req_to_psgi_env {

  my $mojo_req = shift;
  my $url = $mojo_req->url;
  my $base = $url->base;
  my $body =
  Mojolicious::Plugin::MountPSGI::_PSGIInput->new($mojo_req->body);

  my %headers = %{$mojo_req->headers->to_hash};
  for my $key (keys %headers) {
    my $value = $headers{$key};
    delete $headers{$key};
    $key =~ s{-}{_};
    $headers{'HTTP_'. uc $key} = $value;
  }

  return {
    %ENV,
    %headers,
    'SERVER_PROTOCOL'   => 'HTTP/'. $mojo_req->version,
    'SERVER_NAME'       => $base->host,
    'SERVER_PORT'       => $base->port,
    'REQUEST_METHOD'    => $mojo_req->method,
    'SCRIPT_NAME'       => '',
    'PATH_INFO'         => $url->path->to_string,
    'REQUEST_URI'       => $url->to_string,
    'QUERY_STRING'      => $url->query->to_string,
    'psgi.url_scheme'   => $base->scheme,
    'psgi.multithread'  => Plack::Util::FALSE,
    'psgi.version'      => [1,1],
    'psgi.errors'       => *STDERR,
    'psgi.input'        => $body,
    'psgi.multithread'  => Plack::Util::FALSE,
    'psgi.multiprocess' => Plack::Util::TRUE,
    'psgi.run_once'     => Plack::Util::FALSE,
    'psgi.streaming'    => Plack::Util::TRUE,
    'psgi.nonblocking'  => Plack::Util::FALSE,
  };
}

sub _psgi_res_to_mojo_res {
  my $psgi_res = shift;
  my $mojo_res = Mojo::Message::Response->new;
  $mojo_res->code($psgi_res->[0]);
  my $headers = $mojo_res->headers;
  while (scalar @{$psgi_res->[1]}) {
    $headers->header(shift @{$psgi_res->[1]} => shift @{$psgi_res->[1]});
  }

  $headers->remove('Content-Length'); # should be set by mojolicious later

  my $asset = $mojo_res->content->asset;
  Plack::Util::foreach($psgi_res->[2], sub {$asset->add_chunk($_[0])});
  return $mojo_res;
}

package Mojolicious::Plugin::MountPSGI::_PSGIInput;
use strict;
use warnings;

    sub new {
        my ($class, $content) = @_;
        return bless [$content, 0], $class;
    }

    sub read {
        my $self = shift;
        if ($_[0] = substr($self->[0], $self->[1], $_[1])) {
            $self->[1] += $_[1];
            return 1;
        }
    }

1;