POEx-HTTP-Server

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

    - Fixed content-type handling for ->sendfile
    - Tweak doco
    - Require latest POEx::URI

0.0600 Fri Dec 17, 2010
    - Removed debug option.  
    - Fixed the race condition between send/flushed and done
    - Renamed Response->sent to ->headers_sent

0.0500 Wed Dec 15, 2010
    - Added streaming support
    - Document and test above
    - Added sendfile and blocksize
    - Document and test above
    - Improve documentation for ::Error, ::Response and ::Request.

0.0400 Wed Dec 15, 2010
    - Document prefork
    - Created POEx::HTTP::Server::Base
    - Use POE::Session::Multiplex for _psm_begin
    - Allow concurrency>1 and prefork

lib/POEx/HTTP/Server.pm  view on Meta::CPAN

    # wrote a bit of a file
    if( $self->{sendfile} ) {           
        return $self->sendfile_next;    # send some more
    }

    # Request has finished
    if( not $self->{resp} or $self->{S}{done} or $self->{resp}->finished ) {
        return $self->finish_request;
    }

    # streaming?
    elsif( $self->{resp}->streaming ) {     
        return $self->send_more;        # send some more
    }

    # The last possiblity is that calls to ->send have filled up the Wheel's
    # or the driver's buffer and it was flushed.
}

lib/POEx/HTTP/Server.pm  view on Meta::CPAN

        $self->{will_close} = 1 if qq(,$conn,) =~ /,\s*close\s*,/i;
        #warn "$$:conn=$conn will_close=$self->{will_close}";
    }
    else {
        # HTTP/1.0-style keep-alives fail
        #my $conn = $self->{req}->header('Connection')||'';
        #$self->{will_close} = 0 if qq(,$conn,) =~ /,\s*keep-alive\s*,/i;
        #warn "$$:conn=$conn will_close=$self->{will_close}";
    }

    $self->{will_close} = 1 if $self->{resp}->streaming;
    #warn "$$:post streaming will_close=$self->{will_close}";
    $self->{will_close} = 1 unless $self->{keepalive} > 1;
    #warn "$$:post keepalive will_close=$self->{will_close}";
    $self->{will_close} = 1 if $self->{shutdown};
    DEBUG and 
        $self->D( "will_close=$self->{will_close}" );
    return $self->{will_close};
}

#######################################
sub send
{
    my( $self, $something ) = @_;
    DEBUG and $self->D("send");
    confess "Responding more then once to a request" unless $self->{resp};
    unless( $self->{resp}->headers_sent ) {
        $self->should_close;
        $self->send_headers;
        $self->{stream_wheel} = 1;
        $self->{wheel}->set_output_filter( $self->build_stream_filter );
        if( $self->{resp}->streaming ) {
            eval { 
                $SIG{__DIE__} = 'DEFAULT'; 
                $self->__tcp_hot;
            };
            warn $@ if $@;
        }
    }

    $self->output( $something ) if defined $something;
    if( $self->{resp}->streaming and $self->{wheel} ) {
        $self->{wheel}->flush;            
    }
    $self->timeout_start();
    return;
}

# We are in streaming mode.  The last chunk has flushed.  Send a new one
sub send_more
{
    my( $self ) = @_;
    $self->timeout_stop();
    $self->special_dispatch( 'stream_request', $self->{req}, $self->{resp} );
}


# We are in streaming mode.  Turn off Nagle's algorithm
# This isn't as effective as you might think
sub __tcp_hot
{
    my( $self ) = @_;
    DEBUG and 
        $self->D( "TCP_NODELAY" );
    my $h = $self->{wheel}->get_output_handle;
    setsockopt($h, Socket::IPPROTO_TCP(), Socket::TCP_NODELAY(), 1) 
        or die "setsockopt TCP_NODELAY: $!";
    

lib/POEx/HTTP/Server.pm  view on Meta::CPAN

                        handlers => { pre_request => 'poe:my-session/post' }
                     );
    sub post {
        my( $self, $request, $response ) = @_[OBJECT, ARG0, ARG1];
        my $connection = $request->connection;
        # ...
    }

=head3 stream_request

Invoked when a chunk has been flushed to the OS, if you are streaming a
response to the browser.  Streaming is turned on with
L<POEx::HTTP::Server::Response/streaming>.

Please remember that while a chunk might be flushed, the OS's network layer
might still decide to combine several chunks into a single packet.  And this
even though we setup a I<hot> socket with C<TCP_NODELAY> set to 1 and
C<SO_SNDBUF> to 576.

=head3 on_error

Invoked when the server detects an error. C<ARG0> is a
L<POEx::HTTP::Server::Error> object.  

lib/POEx/HTTP/Server.pm  view on Meta::CPAN

=head2 Streaming

Streaming is very similar to sending the headers and body seperately.  See
above.  One difference is that the headers will be flushed and the socket
will be set to I<hot> with TCP_NODELAY and SO_SNBUF.  Another difference is that
keepalive is deactivated for the connection.  Finally difference
is that you will see C<L</stream_request>> when you are allowed to send the
next block. Look for C<L</post_request>> to find out when the last block has
been sent to the browser.

    $resp->streaming( 1 );
    $resp->header( 'Content-Length' => $size );
    $resp->send;

When you want to send a chunk:

    $resp->send( $chunk );

This can be repeated as long as you want.

When you are finished:

lib/POEx/HTTP/Server/Response.pm  view on Meta::CPAN

use File::Basename;
use HTTP::Date;
use HTTP::Status qw( RC_NOT_FOUND RC_FORBIDDEN 
                     RC_NOT_MODIFIED RC_INTERNAL_SERVER_ERROR );

use base qw( HTTP::Response );

sub DEBUG () { 0 }

#######################################
# Get/set streaming status
sub streaming 
{
    my $self = shift;
    my $rv = $self->{__streaming};
    if (@_) { $self->{__streaming} = !!$_[0] }
    return $rv;
}

#######################################
# Get/set if the response header has been sent or not
sub headers_sent
{
    my $self = shift;
    my $rv = $self->{__headers_sent};
    if (@_) { $self->{__headers_sent} = !!$_[0] }

lib/POEx/HTTP/Server/Response.pm  view on Meta::CPAN

    unless( $self->protocol ) {
        $self->protocol( $req->protocol );
    }

    unless( $self->header('Date') ) {
        $self->header( 'Date', time2str(time) );
    }

    if( not defined $self->header( 'Content-Length' ) and
        not $self->streaming and $req->method ne 'HEAD' ) {
        use bytes;
        my $c = $self->content;
        if( defined $c and $c ne '' ) {
            $self->header( 'Content-Length' => length $c );
        }
    }  
}

#######################################
# Helper routine for generating an error

lib/POEx/HTTP/Server/Response.pm  view on Meta::CPAN

=head3 headers_sent

    unless( $resp->headers_sent ) {
        $resp->headers_sent( 1 );
        # ...
    }

Gets or sets the fact that a response header has already been sent.

=head3 streaming

    $resp->streaming( 1 );

Turns on streaming mode for the socket.  L</send> does this also.


=head1 SEE ALSO

L<POEx::HTTP::Server>, L<POEx::HTTP::Server::Response>.

=head1 AUTHOR

Philip Gwyn, E<lt>gwyn -at- cpan.orgE<gt>

t/12_response.t  view on Meta::CPAN

use Test::More tests => 22;
BEGIN { 
    use_ok('POEx::HTTP::Server::Response');
    use_ok('POEx::HTTP::Server::Request');
}

my $resp = POEx::HTTP::Server::Response->new();
isa_ok( $resp, 'POEx::HTTP::Server::Response' );

is( $resp->streaming, undef(), "Streaming isn't set" );
is( $resp->streaming(1), undef(), "Streaming wasn't set" );
is( $resp->streaming, 1, "Streaming is set" );

is( $resp->headers_sent, undef(), "Header not sent" );
is( $resp->headers_sent(1), undef(), "Header wasn't sent" );
is( $resp->headers_sent, 1, "Header is sent" );

my $req = POEx::HTTP::Server::Request->new( GET => "/honk/bonk.html" );
$req->protocol( 'HTTP/1.1' );
isa_ok( $req, 'POEx::HTTP::Server::Request' );

is( $resp->request, undef(), "No request" );
$resp->request( $req );
ok( $resp->request, "Request set" );

$resp->headers_sent( 0 );
$resp->streaming( 0 );
ok( !$resp->protocol, "No protocol specified" );
$resp->__fix_headers;
ok( $resp->protocol, "Protocol now specified" );
ok( $resp->header( 'Date' ) , "Date now set" );
ok( !$resp->header( 'Content-Length' ) , "No Content-Length" );
$resp->content( 'HELLO WORLD' );
$resp->__fix_headers;
is( $resp->header( 'Content-Length' ), 11 , "Set Content-Length" );

$resp->content( 'honk bonk' );
$resp->__fix_headers;
is( $resp->header( 'Content-Length' ), 11 , "Didn't change Content-Length" );

#####
$resp = POEx::HTTP::Server::Response->new();
isa_ok( $resp, 'POEx::HTTP::Server::Response' );
$resp->request( $req );
$resp->content( 'HELLO WORLD' );
$resp->streaming( 1 );
$resp->__fix_headers;
ok( !$resp->header( 'Content-Length' ) , "No Content-Length during streaming" );

#####
$resp = POEx::HTTP::Server::Response->new();
isa_ok( $resp, 'POEx::HTTP::Server::Response' );
$req->method( 'HEAD' );
$resp->request( $req );
$resp->content( 'HELLO WORLD' );
$resp->__fix_headers;
ok( !$resp->header( 'Content-Length' ) , "No Content-Length for HEAD" );

t/32_stream.t  view on Meta::CPAN

    isa_ok( $req, 'POEx::HTTP::Server::Request' );
    isa_ok( $req->connection, 'POEx::HTTP::Server::Connection' );
    isa_ok( $resp, 'POEx::HTTP::Server::Response' );

    my $uri = $req->uri;
    isa_ok( $uri, 'URI' );
    my $N = $uri->query_param( 'N' );
    die "N must be set in ", pp $uri unless $N;
    ok( $N > 0, "$N must be greater then 0" );

    $resp->streaming( 1 );

    $heap->{N} = 0;
    $heap->{max} = $N;
    $resp->send;
}

#######################################
sub stream
{
    my( $heap, $req, $resp ) = @_[ HEAP, ARG0, ARG1 ];