plack handler

gistfile1.txt

package Ult::Server;

use strict;
use warnings;
use IO::Socket::INET;
use Plack::Util;
use Plack::HTTPParser qw( parse_http_request );
use constant MAX_REQUEST_SIZE => 131072;

sub new {
    my ($class, %args) = @_;
    bless \%args, $class;
}

sub run {
    my($self, $app) = @_;
    $self->run_forever($app);
}

sub run_forever {
    my ($self, $app) = @_;

    my %sock_args = (
        Listen => SOMAXCONN,
        LocalPort => 5000,
        LocalAddr => 0,
        Proto => 'tcp',
        ReuseAddr => 1,

    );
    my $listen_sock = IO::Socket::INET->new(%sock_args);
    while (1) {
        if (my $conn = $listen_sock->accept) {
            my $env = {
                SERVER_PORT => 5000,
                SERVER_NAME => 'Ult',
                SCRIPT_NAME => '',
                REMOTE_ADDR => $conn->peerhost,
                REMOTE_PORT => $conn->peerport || 0,
                'psgi.version' => [ 1, 1 ],
                'psgi.errors'  => *STDERR,
                'psgi.url_scheme' => $self->{ssl} ? 'https' : 'http',
                'psgi.run_once'     => Plack::Util::FALSE,
                'psgi.multithread'  => Plack::Util::FALSE,
                'psgi.multiprocess' => Plack::Util::FALSE,
                'psgi.streaming'    => Plack::Util::TRUE,
                'psgi.nonblocking'  => Plack::Util::FALSE,
                'psgix.harakiri'    => Plack::Util::TRUE,
                'psgix.input.buffered' => Plack::Util::TRUE,
                'psgix.io'          => $conn,
            };
            my $buf = '';
            $conn->sysread($buf, MAX_REQUEST_SIZE, 0);
            my $reqlen = parse_http_request($buf, $env);
            open my $input, "<", \$buf;
            $env->{'psgi.input'} = $input;
            my $res = Plack::Util::run_app $app, $env;

            my @lines;
            push @lines, "HTTP/1.0 200 OK\015\012";
            push @lines, "Content-Type: text/html;\015\012";
            push @lines, "Content-Length: " . length($res->[2]->[0]) . "\015\012";
            push @lines, "\015\012";
            push @lines, $res->[2]->[0];
            $conn->syswrite(join '', @lines);
        }
    }
}

1;