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=3d0c03ae3c4919be0c53dca7b96f7633e0b0681e;hp=4ff3f1032c8b85db7d0157bb6a89245223fdc52d;hb=d003ff83ac25ab0af3988de66867f73af54ff631;hpb=398f13dbce1fdbedc6718282fe0f581cb2935798 diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index 4ff3f10..3d0c03a 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -15,9 +15,22 @@ use namespace::clean -except => 'meta'; with 'MooseX::Emulate::Class::Accessor::Fast'; has env => (is => 'ro', writer => '_set_env'); +# XXX Deprecated crap here - warn? +has action => (is => 'rw'); +# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due +# to confusion between Engines and Plugin::Authentication. Remove in 5.8100? +has user => (is => 'rw'); +sub snippets { shift->captures(@_) } -has _read_position => ( is => 'rw', default => 0 ); -has _read_length => ( is => 'ro', +has _read_position => ( + init_arg => undef, + is => 'ro', + writer => '_set_read_position', + default => 0, +); +has _read_length => ( + init_arg => undef, + is => 'ro', default => sub { my $self = shift; $self->header('Content-Length') || 0; @@ -25,10 +38,19 @@ has _read_length => ( is => 'ro', lazy => 1, ); -has action => (is => 'rw'); 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); + +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'); @@ -42,15 +64,29 @@ 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, - clearer => '_clear_context', +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 @@ -73,7 +109,7 @@ sub read { # said there should be. return; } - $self->_read_position( $self->_read_position + $rc ); + $self->_set_read_position( $self->_read_position + $rc ); return $buffer; } else { @@ -91,7 +127,7 @@ has body_parameters => ( is => 'rw', required => 1, lazy => 1, - default => sub { {} }, + builder => 'prepare_body_parameters', ); has uploads => ( @@ -101,11 +137,9 @@ has uploads => ( ); has parameters => ( - is => 'rw', - required => 1, - lazy => 1, - default => sub { {} }, - predicate => '_has_prepared_parameters', + is => 'rw', + lazy => 1, + builder => 'prepare_parameters', ); # TODO: @@ -116,22 +150,28 @@ has parameters => ( # these lazy build from there and kill all the direct hash access # in Catalyst.pm and Engine.pm? -before parameters => sub { - my ($self) = @_; - $self->prepare_body; - $self->_context->engine->prepare_parameters($self->_context); -}; -before body_parameters => sub { - my ($self) = @_; - $self->prepare_body; - $self->prepare_body_parameters; -}; - -=head2 $self->prepare_body() - -sets up the L object body using L +sub prepare_parameters { + my ( $self ) = @_; + 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; + } -=cut + # 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; +} has _uploadtmp => ( is => 'ro', @@ -168,37 +208,41 @@ sub prepare_body { } } -=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 ) = @_; + $self->prepare_body if ! $self->_has_body; return unless $self->_body; - $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here. + return $self->_body->param; } +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')" ); @@ -226,7 +270,7 @@ has _body => ( # and provide a custom reader.. sub body { my $self = shift; - $self->prepare_body(); + $self->prepare_body unless ! $self->_has_body; croak 'body is a reader' if scalar @_; return blessed $self->_body ? $self->_body->body : $self->_body; } @@ -243,17 +287,12 @@ has hostname => ( has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' ); -# XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due -# to confusion between Engines and Plugin::Authentication. Remove in 5.8100? -has user => (is => 'rw'); - sub args { shift->arguments(@_) } sub body_params { shift->body_parameters(@_) } sub input { shift->body(@_) } sub params { shift->parameters(@_) } sub query_params { shift->query_parameters(@_) } sub path_info { shift->path(@_) } -sub snippets { shift->captures(@_) } =for stopwords param params @@ -264,8 +303,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; @@ -292,7 +330,7 @@ Catalyst::Request - provides information about the current client request $req->read; $req->referer; $req->secure; - $req->captures; # previously knows as snippets + $req->captures; $req->upload; $req->uploads; $req->uri; @@ -309,14 +347,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. @@ -623,11 +653,6 @@ actions or regex captures. my @captures = @{ $c->request->captures }; -=head2 $req->snippets - -C used to be called snippets. This is still available for backwards -compatibility, but is considered deprecated. - =head2 $req->upload A convenient method to access $req->uploads. @@ -809,6 +834,43 @@ Returns the value of the C environment variable. Shortcut to $req->headers->user_agent. Returns the user agent (browser) version string. +=head1 SETUP METHODS + +You should never need to call these yourself in application code, +however they are useful if extending Catalyst by applying a request role. + +=head2 $self->prepare_headers() + +Sets up the C<< $res->headers >> accessor. + +=head2 $self->prepare_body() + +Sets up the body using L + +=head2 $self->prepare_body_chunk() + +Add a chunk to the request body. + +=head2 $self->prepare_body_parameters() + +Sets up parameters from body. + +=head2 $self->prepare_cookies() + +Parse cookies from header. Sets up a L object. + +=head2 $self->prepare_connection() + +Sets up various fields in the request like the local and remote addresses, +request method, hostname requested etc. + +=head2 $self->prepare_parameters() + +Ensures that the body has been parsed, then builds the parameters, which are +combined from those in the request and those in the body. + +This method is the builder for the 'parameters' attribute. + =head2 meta Provided by Moose