with 'MooseX::Emulate::Class::Accessor::Fast';
+has env => (is => 'ro', writer => '_set_env');
+
+has _read_position => ( is => 'rw', default => 0 );
+has _read_length => ( is => 'ro',
+ default => sub {
+ my $self = shift;
+ $self->header('Content-Length') || 0;
+ },
+ lazy => 1,
+);
+
has action => (is => 'rw');
has address => (is => 'rw');
has arguments => (is => 'rw', default => sub { [] });
has _context => (
is => 'rw',
weak_ref => 1,
- handles => ['read'],
clearer => '_clear_context',
);
+# Amount of data to read from input on each pass
+our $CHUNKSIZE = 64 * 1024;
+
+sub read {
+ my ($self, $maxlength) = @_;
+ my $remaining = $self->_read_length - $self->_read_position;
+ $maxlength ||= $CHUNKSIZE;
+
+ # Are we done reading?
+ if ( $remaining <= 0 ) {
+ return;
+ }
+
+ my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
+ my $rc = $self->read_chunk( my $buffer, $readlen );
+ if ( defined $rc ) {
+ if (0 == $rc) { # Nothing more to read even though Content-Length
+ # said there should be.
+ return;
+ }
+ $self->_read_position( $self->_read_position + $rc );
+ return $buffer;
+ }
+ else {
+ Catalyst::Exception->throw(
+ message => "Unknown error reading input: $!" );
+ }
+}
+
+sub read_chunk {
+ my $self = shift;
+ return $self->env->{'psgi.input'}->read(@_);
+}
+
has body_parameters => (
is => 'rw',
required => 1,
);
has parameters => (
- is => 'rw',
- required => 1,
- lazy => 1,
- default => sub { {} },
+ is => 'rw',
+ lazy => 1,
+ builder => 'prepare_parameters',
);
# TODO:
# these lazy build from there and kill all the direct hash access
# in Catalyst.pm and Engine.pm?
-before $_ => sub {
+sub prepare_parameters {
+ my ( $self ) = @_;
+
+ $self->prepare_body;
+ my $parameters = {};
+ my $body_parameters = $self->body_parameters;
+ my $query_parameters = $self->query_parameters;
+ # We copy, no references
+ foreach my $name (keys %$query_parameters) {
+ my $param = $query_parameters->{$name};
+ $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
+ }
+
+ # Merge query and body parameters
+ foreach my $name (keys %$body_parameters) {
+ my $param = $body_parameters->{$name};
+ my @values = ref $param eq 'ARRAY' ? @$param : ($param);
+ if ( my $existing = $parameters->{$name} ) {
+ unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
+ }
+ $parameters->{$name} = @values > 1 ? \@values : $values[0];
+ }
+ $parameters;
+}
+
+before body_parameters => sub {
my ($self) = @_;
- my $context = $self->_context || return;
- $context->prepare_body;
-} for qw/parameters body_parameters/;
+ $self->prepare_body;
+ $self->prepare_body_parameters;
+};
+
+=head2 $self->prepare_body()
+
+sets up the L<Catalyst::Request> object body using L<HTTP::Body>
+
+=cut
+
+has _uploadtmp => (
+ is => 'ro',
+ predicate => '_has_uploadtmp',
+);
+
+sub prepare_body {
+ my ( $self ) = @_;
+ if ( my $length = $self->_read_length ) {
+ unless ( $self->_body ) {
+ my $type = $self->header('Content-Type');
+ $self->_body(HTTP::Body->new( $type, $length ));
+ $self->_body->cleanup(1); # Make extra sure!
+ $self->_body->tmpdir( $self->_uploadtmp )
+ if $self->_has_uploadtmp;
+ }
+
+ # Check for definedness as you could read '0'
+ while ( defined ( my $buffer = $self->read() ) ) {
+ $self->prepare_body_chunk($buffer);
+ }
+
+ # paranoia against wrong Content-Length header
+ my $remaining = $length - $self->_read_position;
+ if ( $remaining > 0 ) {
+ Catalyst::Exception->throw(
+ "Wrong Content-Length value: $length" );
+ }
+ }
+ else {
+ # Defined but will cause all body code to be skipped
+ $self->_body(0);
+ }
+}
+
+=head2 $self->prepare_body_chunk()
+
+Add a chunk to the request body.
+
+=cut
+
+sub prepare_body_chunk {
+ my ( $self, $chunk ) = @_;
+
+ $self->_body->add($chunk);
+}
+
+=head2 $self->prepare_body_parameters()
+
+Sets up parameters from body.
+
+=cut
+
+sub prepare_body_parameters {
+ my ( $self ) = @_;
+
+ return unless $self->_body;
+
+ $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
+}
+
+sub prepare_connection {
+ my ($self) = @_;
+
+ my $env = $self->env;
+
+ $self->address( $env->{REMOTE_ADDR} );
+ $self->hostname( $env->{REMOTE_HOST} )
+ if exists $env->{REMOTE_HOST};
+ $self->protocol( $env->{SERVER_PROTOCOL} );
+ $self->remote_user( $env->{REMOTE_USER} );
+ $self->method( $env->{REQUEST_METHOD} );
+ $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
+}
+
+# XXX - FIXME - method is here now, move this crap...
around parameters => sub {
my ($orig, $self, $params) = @_;
if ($params) {
# and provide a custom reader..
sub body {
my $self = shift;
- $self->_context->prepare_body();
+ $self->prepare_body();
croak 'body is a reader' if scalar @_;
return blessed $self->_body ? $self->_body->body : $self->_body;
}
used in a while loop, reading $maxlength bytes on every call. $maxlength
defaults to the size of the request if not specified.
+=head2 $req->read_chunk(\$buff, $max)
+
+Reads a chunk..
+
You have to set MyApp->config(parse_on_demand => 1) to use this directly.
=head2 $req->referer