HTTP-Engine

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

         - Interface::ModPerl
           broken code fix
           using %ENV for RequestBuilder
           add content_type response head handling
         - fixed HTTP::Engine POD

0.0.15   2008-08-28T13:23:29+09:00
         - all Interface design rewrote
         - Interface::Standalone
           some refactoring
           added new option: keepalive_timeout
           bug fixed: keepalive is does not work
         - Interface::ServerSimple
           chaged option: port is required

0.0.14   2008-08-22T18:08:54+09:00
         - Interface::ModPerl broken code fix
         - Interface::POE fix the many problems
         - Interface::Standalone
           bug fixed uri construction
           bug fixed around $req->base
         - some refactoring

MANIFEST  view on Meta::CPAN

t/020_interface/modperl_wildcard_hostname.t
t/020_interface/poe-proxy.t
t/020_interface/poe-uri.t
t/020_interface/poe.t
t/020_interface/psgi-with_plack.t
t/020_interface/psgi.t
t/020_interface/server_simple-net_server_configure.t
t/020_interface/server_simple-not-send-header-bug.t
t/020_interface/server_simple-print_banner.t
t/020_interface/server_simple.t
t/020_interface/standalone-keep_alive.t
t/020_interface/standalone-restart.t
t/020_interface/streaming_response.t
t/020_interface/test-validation.t
t/020_interface/test-warn_at_utf8.t
t/020_interface/test.t
t/020_interface/test_response-with_io.t
t/020_interface/test_upload.t
t/030_daemonize/connection_info.t
t/030_daemonize/headers.t
t/030_daemonize/proxy_path.t

examples/dumper.pl  view on Meta::CPAN

use Data::Dumper;
use HTTP::Engine;
use String::TT qw/strip tt/;

my $engine = HTTP::Engine->new(
    interface => {
        module  => 'Standalone',
        args => {
            port    => 9999,
            fork    => 1,
            keepalive => 1,
        },
        request_handler => sub {
            my $req = shift;
            local $Data::Dumper::Sortkeys = 1;
            die "OK!" if ($req->body_params->{'foo'} || '') eq 'ok';
            my $req_dump = Dumper( $req );
            my $raw      = $req->raw_body;
            my $body     = strip tt q{ 
                <form method="post">
                    <input type="text" name="foo" />

lib/HTTP/Engine/Interface/Standalone.pm  view on Meta::CPAN

use HTTP::Engine::Interface
    builder => 'NoEnv',
    writer  => {
        response_line => 1,
        before => {
            finalize => sub {
                my($self, $req, $res) = @_;

                $res->headers->date(time);

                if ($req->_connection->{keepalive_available}) {
                    $res->headers->header( Connection => 'keep-alive' );
                } else {
                    $res->headers->header( Connection => 'close' );
                }
            }
        }
    }
;


use Socket qw(:all);

lib/HTTP/Engine/Interface/Standalone.pm  view on Meta::CPAN

    isa     => 'Str',
    default => '127.0.0.1',
);

has port => (
    is      => 'ro',
    isa     => 'Int',
    default => 1978,
);

has keepalive => (
    is      => 'ro',
    isa     => 'Bool',
    default => 0,
);

has keepalive_timeout => (
    is      => 'ro',
    isa     => 'Int',
    default => 5,
);

# fixme add preforking support using Parallel::Prefork
has fork => (
    is      => 'ro',
    isa     => 'Bool',
    default => 0,

lib/HTTP/Engine/Interface/Standalone.pm  view on Meta::CPAN


has argv => (
    is      => 'ro',
    isa     => 'ArrayRef',
    default => sub { [] },
);

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

    if ($self->keepalive && !$self->fork) {
        Carp::croak "set fork=1 if you want to work with keepalive!";
    }

    # Setup socket
    my $daemon = IO::Socket::INET->new(
        Listen    => SOMAXCONN,
        LocalAddr => $self->host,
        LocalPort => $self->port,
        Proto     => 'tcp',
        ReuseAddr => 1,
        Type      => SOCK_STREAM,

lib/HTTP/Engine/Interface/Standalone.pm  view on Meta::CPAN

    $remote->autoflush(1);

    while (1) {
        # FIXME refactor an HTTP push parser

        my $headers = $self->_parse_header($remote, $protocol);

        my $connection = lc $headers->header("Connection");
        ### connection: $connection

        my $keepalive_available = $self->keepalive
                                  && index( $connection, 'keep-alive' ) > -1
        ;
        ### keepalive_available: $keepalive_available

        $self->_handle_one($remote, $method, $uri, $protocol, $peername, $headers, $keepalive_available);

        if ($keepalive_available) {
            ### waiting keepalive timeout
            last unless $select->can_read($self->keepalive_timeout);

            ### GO! keep alive!
            last unless ($method, $uri, $protocol) = $self->_parse_request_line($remote, 1);
        } else {
            last;
        }
    }

    $remote->read(my $buf, 4096) if $select->can_read(0); # IE hack

    ### close connection
    $remote->close();
}

sub _parse_request_line {
    my($self, $handle, $is_keepalive) = @_;

    # Parse request line
    my $line = $self->_get_line($handle);
    if ($is_keepalive && ($line eq '' || $line eq "\015")) {
        $line = $self->_get_line($handle);
    }
    return ()
      unless my($method, $uri, $protocol) =
      $line =~ m/\A(\w+)\s+(\S+)(?:\s+HTTP\/(\d+(?:\.\d+)?))?\z/;
    return ($method, $uri, $protocol);
}

sub _peeraddr {
    my ($self, $peername) = @_;

lib/HTTP/Engine/Interface/Standalone.pm  view on Meta::CPAN

            }
        }
        HTTP::Headers::Fast->new(@hdr);
    }
    else {
        HTTP::Headers::Fast->new;
    }
}

sub _handle_one {
    my($self, $remote, $method, $uri, $protocol, $peername, $headers, $keepalive_available) = @_;

    local *STDOUT = $remote;
    $self->handle_request(
        uri => URI::WithBase->new(
            do {
                my $u = URI->new($uri);
                $u->scheme('http');
                $u->host($headers->header('Host') || $self->host);
                $u->port($self->port);
                $u->path('/') if $uri =~ m!^https?://!i;
                my $b = $u->clone;
                $b->path_query('/');
                ($u, $b);
            },
        ),
        headers        => $headers,
        _connection => {
            input_handle        => $remote,
            output_handle       => $remote,
            env                 => {},
            keepalive_available => $keepalive_available,
        },
        connection_info => {
            method         => $method,
            address        => $self->_peeraddr($peername),
            port           => $self->port,
            protocol       => "HTTP/$protocol",
            user           => undef,
            _https_info    => undef,
            request_uri    => $uri,
        },

t/010_core/responsewriter-with_io.t  view on Meta::CPAN


my $writer = DummyRW->new();

tie *STDOUT, 'IO::Scalar', \my $out;

my $req = req(
    protocol => 'HTTP/1.1',
    method => 'GET',
);
my $res = HTTP::Engine::Response->new(body => 'OK!', status => 200);
$res->header( Connection => 'keepalive' );
HTTP::Engine::ResponseFinalizer->finalize( $req, $res );
$writer->finalize($req, $res);

untie *STDOUT;

$out;
--- expected
HTTP/1.1 200 OK
Connection: keepalive
Content-Length: 3
Content-Type: text/html
Status: 200

OK!

=== broken writer
--- input
use t::Utils;

t/020_interface/standalone-keep_alive.t  view on Meta::CPAN

                is doit($port), $pid;
            }
        }
    },
    server => sub {
        my $port = shift;
        HTTP::Engine->new(
            interface => {
                module => 'Standalone',
                args   => {
                    keepalive => 1,
                    port      => $port,
                    fork      => 1,
                    keepalive_timeout => 1000,
                },
                request_handler => sub {
                    my $req = shift;
                    HTTP::Engine::Response->new(
                        status => 200,
                        body   => $$,
                    );
                },
            },
        )->run;

t/020_interface/standalone-restart.t  view on Meta::CPAN

use Test::TCP;
use LWP::UserAgent;
use Test::More;

plan skip_all => 'Interface::Standalone will be removed';
plan tests => 1;

test_tcp(
    client => sub {
        my $port = shift;
        my $ua = LWP::UserAgent->new(keep_alive => 1);
        my $res = $ua->request(HTTP::Request->new('RESTART', "http://localhost:$port/"));
        is $res->code, 500;
    },
    server => sub {
        my $port = shift;
        $SIG{ALRM} = sub { die "timeout" };
        alarm 10;
        HTTP::Engine->new(
            interface => {
                module => 'Standalone',



( run in 1.091 second using v1.01-cache-2.11-cpan-71847e10f99 )