X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=lib%2FCatalyst%2FRequest.pm;h=f974f3f46599cb283a9806564c31ec59cb70fd3e;hb=cfb8879d62b804cb574bf5608dd41cfb87d3559a;hp=afaa4144aeabecc004118c3006b4a706f8b61bb0;hpb=536bee890cf24e0e4bcda7562e7b70cc03ca0620;p=catagits%2FCatalyst-Runtime.git diff --git a/lib/Catalyst/Request.pm b/lib/Catalyst/Request.pm index afaa414..f974f3f 100644 --- a/lib/Catalyst/Request.pm +++ b/lib/Catalyst/Request.pm @@ -106,11 +106,11 @@ has _body => ( is => 'rw', clearer => '_clear_body', predicate => '_has_body', ); # Eugh, ugly. Should just be able to rename accessor methods to 'body' -# and provide a custom reader.. +# and provide a custom reader.. sub body { my $self = shift; $self->_context->prepare_body(); - $self->_body(@_) if scalar @_; + croak 'body is a reader' if scalar @_; return blessed $self->_body ? $self->_body->body : $self->_body; } @@ -120,7 +120,7 @@ has hostname => ( lazy => 1, default => sub { my ($self) = @_; - gethostbyaddr( inet_aton( $self->address ), AF_INET ) || 'localhost' + gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address }, ); @@ -210,7 +210,7 @@ Returns a reference to an array containing the arguments. For example, if your action was - package MyApp::C::Foo; + package MyApp::Controller::Foo; sub moose : Local { ... @@ -223,7 +223,7 @@ Arguments get automatically URI-unescaped for you. =head2 $req->args -Shortcut for arguments. +Shortcut for L. =head2 $req->base @@ -237,8 +237,9 @@ C then C is C. =head2 $req->body -Returns the message body of the request, unless Content-Type is -C or C. +Returns the message body of the request, as returned by L: a string, +unless Content-Type is C, C, or +C, in which case a L object is returned. =head2 $req->body_parameters @@ -300,7 +301,7 @@ Returns a reference to a hash containing the cookies. print $c->request->cookies->{mycookie}->value; -The cookies in the hash are indexed by name, and the values are L +The cookies in the hash are indexed by name, and the values are L objects. =head2 $req->header @@ -315,7 +316,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 $req->uri->host to get the hostname of the server. =head2 $req->input @@ -327,7 +328,7 @@ Contains the keywords portion of a query string, when no '=' signs are present. http://localhost/path?some+keywords - + $c->request->query_keywords will contain 'some keywords' =head2 $req->match @@ -342,7 +343,7 @@ Contains the request method (C, C, C, etc). =head2 $req->param -Returns GET and POST parameters with a CGI.pm-compatible param method. This +Returns GET and POST parameters with a CGI.pm-compatible param method. This is an alternative method for accessing parameters in $c->req->parameters. $value = $c->request->param( 'foo' ); @@ -359,6 +360,21 @@ C. Previously this would have added C as another value to C (creating it if it didn't exist before), and C as another value for C. +B this is considered a legacy interface and care should be taken when +using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first +C param even if multiple are present; C<< $c->req->param( 'foo' ) >> will +return a list of as many are present, which can have unexpected consequences +when writing code of the form: + + $foo->bar( + a => 'b', + baz => $c->req->param( 'baz' ), + ); + +If multiple C parameters are provided this code might corrupt data or +cause a hash initialization error. For a more straightforward interface see +C<< $c->req->parameters >>. + =cut sub param { @@ -411,6 +427,10 @@ Shortcut for $req->parameters. Returns the path, i.e. the part of the URI after $req->base, for the current request. + http://localhost/path/foo + + $c->request->path will contain 'path/foo' + =head2 $req->path_info Alias for path, added for compatibility with L. @@ -451,14 +471,14 @@ be either a scalar or an arrayref containing scalars. print $c->request->query_parameters->{field}; print $c->request->query_parameters->{field}->[0]; - + =head2 $req->read( [$maxlength] ) 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. -You have to set MyApp->config->{parse_on_demand} to use this directly. +You have to set MyApp->config(parse_on_demand => 1) to use this directly. =head2 $req->referer @@ -468,7 +488,7 @@ Shortcut for $req->headers->referer. Returns the referring page. Returns true or false, indicating whether the connection is secure (https). Note that the URI scheme (eg., http vs. https) must be determined -through heuristics, and therefore the reliablity of $req->secure will depend +through heuristics, and therefore the reliability of $req->secure will depend on your server configuration. If you are serving secure pages on the standard SSL port (443) and/or setting the HTTPS environment variable, $req->secure should be valid. @@ -546,7 +566,7 @@ sub upload { =head2 $req->uploads Returns a reference to a hash containing uploads. Values can be either a -L object, or an arrayref of +L object, or an arrayref of L objects. my $upload = $c->request->uploads->{field}; @@ -554,21 +574,37 @@ L objects. =head2 $req->uri -Returns a URI object for the current request. Stringifies to the URI text. +Returns a L object for the current request. Stringifies to the URI text. -=head2 $req->uri_with( { key => 'value' } ); +=head2 $req->mangle_params( { key => 'value' }, $appendmode); -Returns a rewritten URI object for the current request. Key/value pairs -passed in will override existing parameters. You can remove an existing -parameter by passing in an undef value. Unmodified pairs will be -preserved. +Returns a hashref of parameters stemming from the current request's params, +plus the ones supplied. Keys for which no current param exists will be +added, keys with undefined values will be removed and keys with existing +params will be replaced. Note that you can supply a true value as the final +argument to change behavior with regards to existing parameters, appending +values rather than replacing them. + +A quick example: + + # URI query params foo=1 + my $hashref = $req->mangle_params({ foo => 2 }); + # Result is query params of foo=2 + +versus append mode: + + # URI query params foo=1 + my $hashref = $req->mangle_params({ foo => 2 }, 1); + # Result is query params of foo=1&foo=2 + +This is the code behind C. =cut -sub uri_with { - my( $self, $args ) = @_; - - carp( 'No arguments passed to uri_with()' ) unless $args; +sub mangle_params { + my ($self, $args, $append) = @_; + + carp('No arguments passed to mangle_params()') unless $args; foreach my $value ( values %$args ) { next unless defined $value; @@ -577,21 +613,69 @@ sub uri_with { utf8::encode( $_ ) if utf8::is_utf8($_); } }; - - my $uri = $self->uri->clone; - my %query = ( %{ $uri->query_form_hash }, %$args ); - - $uri->query_form( { - # remove undef values - map { defined $query{ $_ } ? ( $_ => $query{ $_ } ) : () } keys %query - } ); - return $uri; + + my %params = %{ $self->uri->query_form_hash }; + foreach my $key (keys %{ $args }) { + my $val = $args->{$key}; + if(defined($val)) { + + if($append && exists($params{$key})) { + + # This little bit of heaven handles appending a new value onto + # an existing one regardless if the existing value is an array + # or not, and regardless if the new value is an array or not + $params{$key} = [ + ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key}, + ref($val) eq 'ARRAY' ? @{ $val } : $val + ]; + + } else { + $params{$key} = $val; + } + } else { + + # If the param wasn't defined then we delete it. + delete($params{$key}); + } + } + + + return \%params; } -=head2 $req->user +=head2 $req->uri_with( { key => 'value' } ); + +Returns a rewritten URI object for the current request. Key/value pairs +passed in will override existing parameters. You can remove an existing +parameter by passing in an undef value. Unmodified pairs will be +preserved. + +You may also pass an optional second parameter that puts C into +append mode: + + $req->uri_with( { key => 'value' }, { mode => 'append' } ); -Returns the currently logged in user. B, do not call, -this will be removed in version 5.81. +See C for an explanation of this behavior. + +=cut + +sub uri_with { + my( $self, $args, $behavior) = @_; + + carp( 'No arguments passed to uri_with()' ) unless $args; + + my $append = 0; + if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) { + $append = 1; + } + + my $params = $self->mangle_params($args, $append); + + my $uri = $self->uri->clone; + $uri->query_form($params); + + return $uri; +} =head2 $req->remote_user