view release on metacpan or  search on metacpan

lib/Web/Request.pm  view on Meta::CPAN

            };
        }

        my $body = HTTP::Body->new($ct, $cl);
        # automatically clean up, but wait until the request object is gone
        $body->cleanup(1);
        $self->_http_body($body);

        my $input = $self->_input;

        my $buffer;
        if ($self->env->{'psgix.input.buffered'}) {
            $input->seek(0, 0);
        }
        else {
            $buffer = Stream::Buffered->new($cl);
        }

        my $spin = 0;
        while ($cl) {
            $input->read(my $chunk, $cl < 8192 ? $cl : 8192);
            my $read = length($chunk);
            $cl -= $read;
            $body->add($chunk);
            $buffer->print($chunk) if $buffer;

            if ($read == 0 && $spin++ > 2000) {
                confess "Bad Content-Length ($cl bytes remaining)";
            }
        }

        if ($buffer) {
            $self->env->{'psgix.input.buffered'} = 1;
            $self->env->{'psgi.input'} = $buffer->rewind;
        }
        else {
            $input->seek(0, 0);
        }

        return {
            body    => $body->param,
            uploads => $body->upload,
        }
    },
    handles => {
        _body    => [ get => 'body' ],
        _uploads => [ get => 'uploads' ],
    },
);

has query_parameters => (
    is      => 'ro',
    isa     => 'HashRef[Str]',
    lazy    => 1,
    clearer => '_clear_query_parameters',
    default => sub {
        my $self = shift;

        my %params = (
            $self->uri->query_form,
            (map { $_ => '' } $self->uri->query_keywords),
        );
        return {
            map { $self->_decode($_) } map { $_ => $params{$_} } keys %params
        };
    },
);

has all_query_parameters => (
    is      => 'ro',
    isa     => 'HashRef[ArrayRef[Str]]',
    lazy    => 1,
    clearer => '_clear_all_query_parameters',
    default => sub {
        my $self = shift;

        my @params = $self->uri->query_form;
        my $ret = {};

        while (my ($k, $v) = splice @params, 0, 2) {
            $k = $self->_decode($k);
            push @{ $ret->{$k} ||= [] }, $self->_decode($v);
        }

        return $ret;
    },
);

has body_parameters => (
    is      => 'ro',
    isa     => 'HashRef[Str]',
    lazy    => 1,
    clearer => '_clear_body_parameters',
    default => sub {
        my $self = shift;

        my $body = $self->_body;

        my $ret = {};
        for my $key (keys %$body) {
            my $val = $body->{$key};
            $key = $self->_decode($key);
            $ret->{$key} = $self->_decode(ref($val) ? $val->[-1] : $val);
        }

        return $ret;
    },
);

has all_body_parameters => (
    is      => 'ro',
    isa     => 'HashRef[ArrayRef[Str]]',
    lazy    => 1,
    clearer => '_clear_all_body_parameters',
    default => sub {
        my $self = shift;

        my $body = $self->_body;

        my $ret = {};
        for my $key (keys %$body) {