X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=catagits%2FCatalyst-Runtime.git;a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=442f88825b9007f6c46a63506c9a4a39ce7e86f2;hp=94c6400239323aaf6303bae95956a9e3106fa233;hb=767480fd8b4151e350831a52dbc9c6265bf84485;hpb=bb48c5566ee0170fd913574d2393f381d214f86c diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 94c6400..442f888 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -14,10 +14,37 @@ use namespace::clean -except => 'meta'; with 'MooseX::Emulate::Class::Accessor::Fast'; -has action => (is => 'rw'); +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'); # XXX Deprecated - warn? has address => (is => 'rw'); has arguments => (is => 'rw', default => sub { [] }); -has cookies => (is => 'rw', default => sub { {} }); +has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1); + +=head2 $self->prepare_cookies($c) + +Parse cookies from header. Sets a L object. + +=cut + +sub prepare_cookies { + my ( $self ) = @_; + + if ( my $header = $self->header('Cookie') ) { + return { CGI::Simple::Cookie->parse($header) }; + } + {}; +} + has query_keywords => (is => 'rw'); has match => (is => 'rw'); has method => (is => 'rw'); @@ -31,18 +58,69 @@ has headers => ( is => 'rw', isa => 'HTTP::Headers', handles => [qw(content_encoding content_length content_type header referer user_agent)], - default => sub { HTTP::Headers->new() }, - required => 1, + builder => 'prepare_headers', lazy => 1, ); -has _context => ( - is => 'rw', - weak_ref => 1, - handles => ['read'], - clearer => '_clear_context', +=head2 $self->prepare_headers($c) + +=cut + +sub prepare_headers { + my ($self) = @_; + + my $env = $self->env; + my $headers = HTTP::Headers->new(); + + for my $header (keys %{ $env }) { + next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i; + (my $field = $header) =~ s/^HTTPS?_//; + $field =~ tr/_/-/; + $headers->header($field => $env->{$header}); + } + return $headers; +} + +has _log => ( + is => 'ro', + weak_ref => 1, + required => 1, ); +# 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, @@ -57,10 +135,9 @@ has uploads => ( ); has parameters => ( - is => 'rw', - required => 1, - lazy => 1, - default => sub { {} }, + is => 'rw', + lazy => 1, + builder => 'prepare_parameters', ); # TODO: @@ -71,17 +148,124 @@ has parameters => ( # 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 object body using L + +=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) { if ( !ref $params ) { - $self->_context->log->warn( + $self->_log->warn( "Attempt to retrieve '$params' with req->params(), " . "you probably meant to call req->param('$params')" ); @@ -109,7 +293,7 @@ has _body => ( # 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; } @@ -138,6 +322,8 @@ sub query_params { shift->query_parameters(@_) } sub path_info { shift->path(@_) } sub snippets { shift->captures(@_) } +=for stopwords param params + =head1 NAME Catalyst::Request - provides information about the current client request @@ -145,8 +331,7 @@ Catalyst::Request - provides information about the current client request =head1 SYNOPSIS $req = $c->request; - $req->action; - $req->address; + $req->address eq "127.0.0.1"; $req->arguments; $req->args; $req->base; @@ -190,14 +375,6 @@ thus hiding the details of the particular engine implementation. =head1 METHODS -=head2 $req->action - -[DEPRECATED] Returns the name of the requested action. - - -Use C<< $c->action >> instead (which returns a -L object). - =head2 $req->address Returns the IP address of the client. @@ -316,7 +493,7 @@ Returns an L object containing the headers for the current reques =head2 $req->hostname -Returns the hostname of the client. +Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server. =head2 $req->input @@ -478,6 +655,10 @@ Reads a chunk of data from the request body. This method is intended to be 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