File Coverage

blib/lib/Plack/Request.pm

Criterion	Covered	Total	%
statement	149	164	90.8
branch	30	36	83.3
condition	22	33	66.6
subroutine	45	59	76.2
pod	38	40	95.0
total	284	332	85.5

package Plack::Request;
use strict;
use warnings;
use 5.008_001;
our $VERSION = '1.0049';

use HTTP::Headers::Fast;
use Carp ();
use Hash::MultiValue;

use Plack::Request::Upload;
use Stream::Buffered;
use URI;
use URI::Escape ();
use Cookie::Baker ();

use HTTP::Entity::Parser;
use WWW::Form::UrlEncoded qw/parse_urlencoded_arrayref/;

sub new {
    my($class, $env) = @_;
    Carp::croak(q{$env is required})
        unless defined $env && ref($env) eq 'HASH';

    bless { env => $env }, $class;
}

sub env { $_[0]->{env} }

sub address     { $_[0]->env->{REMOTE_ADDR} }
sub remote_host { $_[0]->env->{REMOTE_HOST} }
sub protocol    { $_[0]->env->{SERVER_PROTOCOL} }
sub method      { $_[0]->env->{REQUEST_METHOD} }
sub port        { $_[0]->env->{SERVER_PORT} }
sub user        { $_[0]->env->{REMOTE_USER} }
sub request_uri { $_[0]->env->{REQUEST_URI} }
sub path_info   { $_[0]->env->{PATH_INFO} }
sub path        { $_[0]->env->{PATH_INFO} || '/' }
sub query_string{ $_[0]->env->{QUERY_STRING} }
sub script_name { $_[0]->env->{SCRIPT_NAME} }
sub scheme      { $_[0]->env->{'psgi.url_scheme'} }
sub secure      { $_[0]->scheme eq 'https' }
sub body        { $_[0]->env->{'psgi.input'} }
sub input       { $_[0]->env->{'psgi.input'} }

sub content_length   { $_[0]->env->{CONTENT_LENGTH} }
sub content_type     { $_[0]->env->{CONTENT_TYPE} }

sub session         { $_[0]->env->{'psgix.session'} }
sub session_options { $_[0]->env->{'psgix.session.options'} }
sub logger          { $_[0]->env->{'psgix.logger'} }

sub cookies {
    my $self = shift;

    return {} unless $self->env->{HTTP_COOKIE};

    # HTTP_COOKIE hasn't changed: reuse the parsed cookie
    if (   $self->env->{'plack.cookie.parsed'}
        && $self->env->{'plack.cookie.string'} eq $self->env->{HTTP_COOKIE}) {
        return $self->env->{'plack.cookie.parsed'};
    }

    $self->env->{'plack.cookie.string'} = $self->env->{HTTP_COOKIE};
    $self->env->{'plack.cookie.parsed'} = Cookie::Baker::crush_cookie($self->env->{'plack.cookie.string'});
}

sub content {
    my $self = shift;

    unless ($self->env->{'psgix.input.buffered'}) {
        $self->_parse_request_body;
    }

    my $fh = $self->input                 or return '';
    my $cl = $self->env->{CONTENT_LENGTH} or return '';

    $fh->seek(0, 0); # just in case middleware/apps read it without seeking back
    $fh->read(my($content), $cl, 0);
    $fh->seek(0, 0);

    return $content;
}

sub raw_body { $_[0]->content }

# XXX you can mutate headers with ->headers but it's not written through to the env

sub headers {
    my $self = shift;
    if (!defined $self->{headers}) {
        my $env = $self->env;
        $self->{headers} = HTTP::Headers::Fast->new(
            map {
                (my $field = $_) =~ s/^HTTPS?_//;
                ( lc($field) => $env->{$_} );
            }
                grep { /^(?:HTTP|CONTENT)/i } keys %$env
            );
    }
    $self->{headers};
}

sub content_encoding { shift->headers->content_encoding(@_) }
sub header           { shift->headers->header(@_) }
sub referer          { shift->headers->referer(@_) }
sub user_agent       { shift->headers->user_agent(@_) }

sub _body_parameters {
    my $self = shift;
    unless ($self->env->{'plack.request.body_parameters'}) {
        $self->_parse_request_body;
    }
    return $self->env->{'plack.request.body_parameters'};
}

sub _query_parameters {
    my $self = shift;
    $self->env->{'plack.request.query_parameters'} ||= parse_urlencoded_arrayref($self->env->{'QUERY_STRING'});
}

sub query_parameters {
    my $self = shift;
    $self->env->{'plack.request.query'} ||= Hash::MultiValue->new(@{$self->_query_parameters});
}

sub body_parameters {
    my $self = shift;
    $self->env->{'plack.request.body'} ||= Hash::MultiValue->new(@{$self->_body_parameters});
}

# contains body + query
sub parameters {
    my $self = shift;

    $self->env->{'plack.request.merged'} ||= do {
        Hash::MultiValue->new(
            @{$self->_query_parameters},
            @{$self->_body_parameters}
        );
    };
}

sub uploads {
    my $self = shift;

    if ($self->env->{'plack.request.upload'}) {
        return $self->env->{'plack.request.upload'};
    }

    $self->_parse_request_body;
    return $self->env->{'plack.request.upload'};
}

sub param {
    my $self = shift;

    return keys %{ $self->parameters } if @_ == 0;

    my $key = shift;
    return $self->parameters->{$key} unless wantarray;
    return $self->parameters->get_all($key);
}

sub upload {
    my $self = shift;

    return keys %{ $self->uploads } if @_ == 0;

    my $key = shift;
    return $self->uploads->{$key} unless wantarray;
    return $self->uploads->get_all($key);
}

sub uri {
    my $self = shift;

    my $base = $self->_uri_base;

    # We have to escape back PATH_INFO in case they include stuff like
    # ? or # so that the URI parser won't be tricked. However we should
    # preserve '/' since encoding them into %2f doesn't make sense.
    # This means when a request like /foo%2fbar comes in, we recognize
    # it as /foo/bar which is not ideal, but that's how the PSGI PATH_INFO
    # spec goes and we can't do anything about it. See PSGI::FAQ for details.

    # See RFC 3986 before modifying.
    my $path_escape_class = q{^/;:@&=A-Za-z0-9\$_.+!*'(),-};

    my $path = URI::Escape::uri_escape($self->env->{PATH_INFO} || '', $path_escape_class);
    $path .= '?' . $self->env->{QUERY_STRING}
        if defined $self->env->{QUERY_STRING} && $self->env->{QUERY_STRING} ne '';

    $base =~ s!/$!! if $path =~ m!^/!;

    return URI->new($base . $path)->canonical;
}

sub base {
    my $self = shift;
    URI->new($self->_uri_base)->canonical;
}

sub _uri_base {
    my $self = shift;

    my $env = $self->env;

    my $uri = ($env->{'psgi.url_scheme'} || "http") .
        "://" .
        ($env->{HTTP_HOST} || (($env->{SERVER_NAME} || "") . ":" . ($env->{SERVER_PORT} || 80))) .
        ($env->{SCRIPT_NAME} || '/');

    return $uri;
}

sub new_response {
    my $self = shift;
    require Plack::Response;
    Plack::Response->new(@_);
}

sub request_body_parser {
    my $self = shift;
    $self->{request_body_parser} ||= $self->_build_body_parser;
}

sub _build_body_parser {
    my $self = shift;

    my $len = $self->_buffer_length_for($self->env);

    my $parser = HTTP::Entity::Parser->new(buffer_length => $len);
    $parser->register('application/x-www-form-urlencoded', 'HTTP::Entity::Parser::UrlEncoded');
    $parser->register('multipart/form-data', 'HTTP::Entity::Parser::MultiPart');

    $parser;
}

sub _buffer_length_for {
    my($self, $env) = @_;

    return $ENV{PLACK_BUFFER_LENGTH} if defined $ENV{PLACK_BUFFER_LENGTH};

    if ($env->{'psgix.input.buffered'}) {
        return 1024 * 1024; # 1MB for buffered
    } else {
        return 1024 * 64; # 64K for unbuffered
    }
}

sub _parse_request_body {
    my $self = shift;

    my ($params,$uploads) = $self->request_body_parser->parse($self->env);
    $self->env->{'plack.request.body_parameters'} = $params;

    my $upload_hash = Hash::MultiValue->new();
    while ( my ($k,$v) = splice @$uploads, 0, 2 ) {
        my %copy = %$v;
        $copy{headers} = HTTP::Headers::Fast->new(@{$v->{headers}});
        $upload_hash->add($k, Plack::Request::Upload->new(%copy));
    }
    $self->env->{'plack.request.upload'} = $upload_hash;
    1;
}

1;
__END__