X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=c859fd27af793fcc6f03570d942f14bfdefe55f1;hb=b354201608d428db344c63dd35de096a62a7a9d3;hp=e134fbebc0eea2e625f9cc20aaee79cdac115011;hpb=059c085bfcead450e70ace9ef193aa99ac2ab37d;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index e134fbe..c859fd2 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -6,38 +6,56 @@ use utf8; use URI::http; use URI::https; use URI::QueryParam; +use HTTP::Headers; use Moose; -has action => (is => 'rw'); -has address => (is => 'rw'); -has arguments => (is => 'rw', default => sub { [] }); -has cookies => (is => 'rw', default => sub { {} }); -has query_keywords => (is => 'rw'); -has match => (is => 'rw'); -has method => (is => 'rw'); -has protocol => (is => 'rw'); +use namespace::clean -except => 'meta'; + +with 'MooseX::Emulate::Class::Accessor::Fast'; + +has action => (is => 'rw'); +has address => (is => 'rw'); +has arguments => (is => 'rw', default => sub { [] }); +has cookies => (is => 'rw', default => sub { {} }); +has query_keywords => (is => 'rw'); +has match => (is => 'rw'); +has method => (is => 'rw'); +has protocol => (is => 'rw'); has query_parameters => (is => 'rw', default => sub { {} }); -has secure => (is => 'rw', default => 0); -has captures => (is => 'rw', default => sub { [] }); -has uri => (is => 'rw'); -has user => (is => 'rw'); -has headers => ( - is => 'rw', +has secure => (is => 'rw', default => 0); +has captures => (is => 'rw', default => sub { [] }); +has uri => (is => 'rw', predicate => 'has_uri'); +has user => (is => 'rw'); +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, + lazy => 1, ); +# Moose TODO: +# - Can we lose the before modifiers which just call prepare_body ? +# they are wasteful, slow us down and feel cluttery. +# Can we call prepare_body at BUILD time? +# Can we make _body an attribute, have the rest of +# these lazy build from there and kill all the direct hash access +# in Catalyst.pm and Engine.pm? + has _context => ( is => 'rw', weak_ref => 1, + handles => ['read'], + clearer => '_clear_context', ); has body_parameters => ( - is => 'rw', - required => 1, - lazy => 1, - default => sub { {} }, + is => 'rw', + required => 1, + lazy => 1, + default => sub { {} }, ); before body_parameters => sub { @@ -46,17 +64,11 @@ before body_parameters => sub { }; has uploads => ( - is => 'rw', - required => 1, - lazy => 1, - default => sub { {} }, + is => 'rw', + required => 1, + default => sub { {} }, ); -before uploads => sub { - my ($self) = @_; - $self->_context->prepare_body; -}; - has parameters => ( is => 'rw', required => 1, @@ -66,9 +78,8 @@ has parameters => ( before parameters => sub { my ($self, $params) = @_; - $self->_context->prepare_body(); if ( $params && !ref $params ) { - $self->_context->log->warn( + $self->_context->log->warn( "Attempt to retrieve '$params' with req->params(), " . "you probably meant to call req->param('$params')" ); $params = undef; @@ -77,25 +88,26 @@ before parameters => sub { }; has base => ( - is => 'rw', - required => 1, - lazy => 1, - default => sub { + is => 'rw', + required => 1, + lazy => 1, + default => sub { my $self = shift; - if( $self->uri ){ - return $self->path; - } + return $self->path if $self->has_uri; }, ); -has body => ( - is => 'rw' +has _body => ( + is => 'rw', clearer => '_clear_body', predicate => '_has_body', ); - -before body => sub { - my ($self) = @_; +# Eugh, ugly. Should just be able to rename accessor methods to 'body' +# and provide a custom reader.. +sub body { + my $self = shift; $self->_context->prepare_body(); -}; + $self->_body(@_) if scalar @_; + return blessed $self->_body ? $self->_body->body : $self->_body; +} has hostname => ( is => 'rw', @@ -103,11 +115,11 @@ has hostname => ( lazy => 1, default => sub { my ($self) = @_; - gethostbyaddr( inet_aton( $self->address ), AF_INET ) + gethostbyaddr( inet_aton( $self->address ), AF_INET ) || 'localhost' }, ); -no Moose; +has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' ); sub args { shift->arguments(@_) } sub body_params { shift->body_parameters(@_) } @@ -198,6 +210,9 @@ For example, if your action was and the URI for the request was C, the string C would be the first and only argument. +Arguments just get passed through and B get unescaped automatically, so +you should do that explicitly. + =head2 $req->args Shortcut for arguments. @@ -223,7 +238,7 @@ be either a scalar or an arrayref containing scalars. print $c->request->body_parameters->{field}->[0]; These are the parameters from the POST part of the request, if any. - + =head2 $req->body_params Shortcut for body_parameters. @@ -290,7 +305,7 @@ Returns an L object containing the headers for the current reques =head2 $req->hostname Returns the hostname of the client. - + =head2 $req->input Alias for $req->body. @@ -387,7 +402,7 @@ Returns the path, i.e. the part of the URI after $req->base, for the current req =head2 $req->path_info -Alias for path, added for compability with L. +Alias for path, added for compatibility with L. =cut @@ -396,17 +411,17 @@ sub path { if (@params) { $self->uri->path(@params); - undef $self->{path}; + $self->_clear_path; } - elsif ( defined( my $path = $self->{path} ) ) { - return $path; + elsif ( $self->_has_path ) { + return $self->_path; } else { my $path = $self->uri->path; my $location = $self->base->path; $path =~ s/^(\Q$location\E)?//; $path =~ s/^\///; - $self->{path} = $path; + $self->_path($path); return $path; } @@ -434,10 +449,6 @@ defaults to the size of the request if not specified. You have to set MyApp->config->{parse_on_demand} to use this directly. -=cut - -sub read { shift->_context->read(@_); } - =head2 $req->referer Shortcut for $req->headers->referer. Returns the referring page. @@ -448,13 +459,14 @@ Returns true or false, indicating whether the connection is secure (https). =head2 $req->captures -Returns a reference to an array containing regex captures. +Returns a reference to an array containing captured args from chained +actions or regex captures. my @captures = @{ $c->request->captures }; =head2 $req->snippets -C used to be called snippets. This is still available for backwoards +C used to be called snippets. This is still available for backwards compatibility, but is considered deprecated. =head2 $req->upload @@ -531,7 +543,8 @@ Returns a URI object for the current request. Stringifies to the URI text. =head2 $req->uri_with( { key => 'value' } ); Returns a rewritten URI object for the current request. Key/value pairs -passed in will override existing parameters. Unmodified pairs will be +passed in will override existing parameters. You can remove an existing +parameter by passing in an undef value. Unmodified pairs will be preserved. =cut @@ -541,7 +554,7 @@ sub uri_with { carp( 'No arguments passed to uri_with()' ) unless $args; - for my $value ( values %$args ) { + foreach my $value ( values %$args ) { next unless defined $value; for ( ref $value eq 'ARRAY' ? @$value : $value ) { $_ = "$_"; @@ -549,11 +562,12 @@ sub uri_with { } }; - my $uri = $self->uri->clone; - + my $uri = $self->uri->clone; + my %query = ( %{ $uri->query_form_hash }, %$args ); + $uri->query_form( { - %{ $uri->query_form_hash }, - %$args + # remove undef values + map { defined $query{ $_ } ? ( $_ => $query{ $_ } ) : () } keys %query } ); return $uri; } @@ -574,9 +588,7 @@ Provided by Moose =head1 AUTHORS -Sebastian Riedel, C - -Marcus Ramberg, C +Catalyst Contributors, see Catalyst.pm =head1 COPYRIGHT @@ -585,4 +597,6 @@ it under the same terms as Perl itself. =cut +__PACKAGE__->meta->make_immutable; + 1;