File Coverage

blib/lib/POEx/HTTP/Server/Response.pm

Criterion	Covered	Total	%
statement	90	105	85.7
branch	25	34	73.5
condition	12	20	60.0
subroutine	17	18	94.4
pod	8	8	100.0
total	152	185	82.1

# $Id: Response.pm 909 2012-07-13 15:38:39Z fil $
# Copyright 2010 Philip Gwyn

package POEx::HTTP::Server::Response;

use strict;
use warnings;

use Carp;
use POE;
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] }
    return $rv;
}

#######################################
# End the request
sub done
{
    my( $self ) = @_;
    unless( $self->{__done} ) {
        carp "Only call ", ref($self), "->done once";
        return;
    }

    $poe_kernel->post( @{ delete $self->{__done} } );
}

sub finished { not exists $_[0]->{__done} }

#######################################
# Send some data.  But not all the data
sub send
{
    my( $self, $something ) = @_;
    $self->__fix_headers;
    $poe_kernel->post( @{ $self->{__send} }, $something );
}

#######################################
# Send the response
sub respond
{
    my( $self ) = @_;

    croak "Responding more then once to a request" unless $self->{__respond};

    $self->__fix_headers;
    $poe_kernel->post( @{ delete $self->{__respond} } );
}

sub __fix_headers
{
    my( $self ) = @_;
    return if $self->headers_sent;
    my $req = $self->request;

    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
sub error
{
    my( $self, $rc, $text ) = @_;

    $self->code( $rc );
    $self->content_type( 'text/plain' )
        unless defined $self->content_type;
    $self->content( $text );

    $self->respond;
    $self->done;

}

#######################################
# Send a file to the client
sub sendfile
{
    my( $self, $file, $ct ) = @_;

    DEBUG and warn "file=$file";

    my $path = $self->request->uri ?
               $self->request->uri->path : basename $file;
    unless( -f $file ) {
        $self->error( RC_NOT_FOUND, "No such file or directory $path" );
        return;
    }
    unless( -r $file ) {
        $self->error( RC_FORBIDDEN, "Denied $path: $!" );
        return;
    }

    # Info about the file
    my $lastmod = (stat $file)[9];
    my $size    = (stat $file)[7];
    DEBUG and warn "lastmod=$lastmod size=$size";

    # some required headers
    $self->header( 'Last-Modified' => time2str( $lastmod ) );
    unless( defined $self->content_type ) {
        $ct ||= 'application/octet-stream';
        DEBUG and warn "ct=$ct";
        $self->content_type( $ct );
    }

    # Bail early for HEAD requests
    if ( $self->request->method eq 'HEAD' and $size ) {
        $self->header( 'Content-Length' => $size );
        $self->respond;
        $self->done;
        return;
    }

    # Bail early for If-Modified-Since
    my $since = $self->request->header( 'If-Modified-Since' );
    if( $since ) {
        $since = str2time( $since );
        if ( $lastmod && $since && $since >= $lastmod ) {
            $self->remove_header( 'Last-Modified' );
            ## RFC 2616 section 4.3 says no content-length for 403
            # $response->content_length( $size );
            $self->code( RC_NOT_MODIFIED );
            $self->respond;
            $self->done;
            return;
        }
    }

    $self->header( 'Content-Length' => $size );
    $self->__fix_headers;

    $poe_kernel->post( @{ $self->{__sendfile} }, $path, $file, $size );
}


1;

__END__