From 9cec74a83eca5315aa84f534d7471bb29a73a9e1 Mon Sep 17 00:00:00 2001 From: Jesse Luehrs Date: Sun, 30 Sep 2012 16:06:12 -0500 Subject: use Stream::Buffered instead of storing the full content in memory --- lib/Web/Request.pm | 56 +++++++++++++++++++++++++++++------------------------- 1 file changed, 30 insertions(+), 26 deletions(-) diff --git a/lib/Web/Request.pm b/lib/Web/Request.pm index db86275..6fb94a3 100644 --- a/lib/Web/Request.pm +++ b/lib/Web/Request.pm @@ -7,6 +7,7 @@ use Encode (); use HTTP::Body (); use HTTP::Headers (); use HTTP::Message::PSGI (); +use Stream::Buffered (); use URI (); use URI::Escape (); @@ -178,6 +179,7 @@ has _http_body => ( has _parsed_body => ( traits => ['Hash'], + is => 'ro', isa => 'HashRef', lazy => 1, default => sub { @@ -200,60 +202,46 @@ has _parsed_body => ( my $input = $self->_input; + my $buffer; if ($self->env->{'psgix.input.buffered'}) { - seek $input, 0, 0; + $input->seek(0, 0); + } + else { + my $buffer = Stream::Buffered->new($cl); } - my $content = ''; my $spin = 0; while ($cl) { - read $input, my $chunk, $cl < 8192 ? $cl : 8192; + $input->read(my $chunk, $cl < 8192 ? $cl : 8192); my $read = length($chunk); $cl -= $read; $body->add($chunk); - $content .= $chunk; + $buffer->print($chunk) if $buffer; if ($read == 0 && $spin++ > 2000) { confess "Bad Content-Length ($cl bytes remaining)"; } } - if ($self->env->{'psgix.input.buffered'}) { - seek $input, 0, 0; + if ($buffer) { + $self->env->{'psgix.input.buffered'} = 1; + $self->env->{'psgi.input'} = $buffer->rewind; } else { - open my $fh, '<', \$content; - $self->env->{'psgi.input'} = $fh; - $self->env->{'psgix.input.buffered'} = 1; + $input->seek(0, 0); } return { - content => $content, body => $body->param, uploads => $body->upload, } }, handles => { - _content => [ get => 'content' ], _body => [ get => 'body' ], _uploads => [ get => 'uploads' ], }, ); -has content => ( - is => 'ro', - isa => 'Str', - lazy => 1, - clearer => '_clear_content', - default => sub { - my $self = shift; - - # XXX get Plack::TempBuffer onto CPAN separately, so that this doesn't - # always have to be sitting in memory - return $self->_decode($self->_content); - }, -); - has query_parameters => ( is => 'ro', isa => 'HashRef[Str]', @@ -476,6 +464,23 @@ sub param { $self->parameters->{$key}; } +sub content { + my $self = shift; + + unless ($self->env->{'psgix.input.buffered'}) { + # the builder for this attribute also sets up psgi.input + $self->_parsed_body; + } + + my $fh = $self->_input or return ''; + my $cl = $self->content_length or return ''; + + $fh->read(my $content, $cl, 0); + $fh->seek(0, 0); + + return $self->_decode($content); +} + sub _decode { my $self = shift; my ($content) = @_; @@ -503,7 +508,6 @@ sub encoding { sub _clear_encoded_data { my $self = shift; $self->_clear_encoding_obj; - $self->_clear_content; $self->_clear_query_parameters; $self->_clear_all_query_parameters; $self->_clear_body_parameters; -- cgit v1.2.3-54-g00ecf