1 package Catalyst::Request;
3 use IO::Socket qw[AF_INET inet_aton];
13 use namespace::clean -except => 'meta';
15 with 'MooseX::Emulate::Class::Accessor::Fast';
17 has env => (is => 'ro', writer => '_set_env');
19 has _read_position => ( is => 'rw', default => 0 );
20 has _read_length => ( is => 'ro',
23 $self->header('Content-Length') || 0;
28 has action => (is => 'rw');
29 has address => (is => 'rw');
30 has arguments => (is => 'rw', default => sub { [] });
31 has cookies => (is => 'rw', default => sub { {} });
32 has query_keywords => (is => 'rw');
33 has match => (is => 'rw');
34 has method => (is => 'rw');
35 has protocol => (is => 'rw');
36 has query_parameters => (is => 'rw', default => sub { {} });
37 has secure => (is => 'rw', default => 0);
38 has captures => (is => 'rw', default => sub { [] });
39 has uri => (is => 'rw', predicate => 'has_uri');
40 has remote_user => (is => 'rw');
43 isa => 'HTTP::Headers',
44 handles => [qw(content_encoding content_length content_type header referer user_agent)],
45 default => sub { HTTP::Headers->new() },
53 clearer => '_clear_context',
56 # Amount of data to read from input on each pass
57 our $CHUNKSIZE = 64 * 1024;
60 my ($self, $maxlength) = @_;
61 my $remaining = $self->_read_length - $self->_read_position;
62 $maxlength ||= $CHUNKSIZE;
64 # Are we done reading?
65 if ( $remaining <= 0 ) {
69 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
70 my $rc = $self->read_chunk( my $buffer, $readlen );
72 if (0 == $rc) { # Nothing more to read even though Content-Length
73 # said there should be.
76 $self->_read_position( $self->_read_position + $rc );
80 Catalyst::Exception->throw(
81 message => "Unknown error reading input: $!" );
87 return $self->env->{'psgi.input'}->read(@_);
90 has body_parameters => (
94 default => sub { {} },
100 default => sub { {} },
106 builder => 'prepare_parameters',
110 # - Can we lose the before modifiers which just call prepare_body ?
111 # they are wasteful, slow us down and feel cluttery.
113 # Can we make _body an attribute, have the rest of
114 # these lazy build from there and kill all the direct hash access
115 # in Catalyst.pm and Engine.pm?
117 sub prepare_parameters {
122 my $body_parameters = $self->body_parameters;
123 my $query_parameters = $self->query_parameters;
124 # We copy, no references
125 foreach my $name (keys %$query_parameters) {
126 my $param = $query_parameters->{$name};
127 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
130 # Merge query and body parameters
131 foreach my $name (keys %$body_parameters) {
132 my $param = $body_parameters->{$name};
133 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
134 if ( my $existing = $parameters->{$name} ) {
135 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
137 $parameters->{$name} = @values > 1 ? \@values : $values[0];
142 before body_parameters => sub {
145 $self->prepare_body_parameters;
148 =head2 $self->prepare_body()
150 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
156 predicate => '_has_uploadtmp',
162 if ( my $length = $self->_read_length ) {
163 unless ( $self->_body ) {
164 my $type = $self->header('Content-Type');
165 $self->_body(HTTP::Body->new( $type, $length ));
166 $self->_body->cleanup(1); # Make extra sure!
167 $self->_body->tmpdir( $self->_uploadtmp )
168 if $self->_has_uploadtmp;
171 # Check for definedness as you could read '0'
172 while ( defined ( my $buffer = $self->read() ) ) {
173 $self->prepare_body_chunk($buffer);
176 # paranoia against wrong Content-Length header
177 my $remaining = $length - $self->_read_position;
178 if ( $remaining > 0 ) {
179 Catalyst::Exception->throw(
180 "Wrong Content-Length value: $length" );
184 # Defined but will cause all body code to be skipped
189 =head2 $self->prepare_body_chunk()
191 Add a chunk to the request body.
195 sub prepare_body_chunk {
196 my ( $self, $chunk ) = @_;
198 $self->_body->add($chunk);
201 =head2 $self->prepare_body_parameters()
203 Sets up parameters from body.
207 sub prepare_body_parameters {
210 return unless $self->_body;
212 $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
215 sub prepare_connection {
218 my $env = $self->env;
220 $self->address( $env->{REMOTE_ADDR} );
221 $self->hostname( $env->{REMOTE_HOST} )
222 if exists $env->{REMOTE_HOST};
223 $self->protocol( $env->{SERVER_PROTOCOL} );
224 $self->remote_user( $env->{REMOTE_USER} );
225 $self->method( $env->{REQUEST_METHOD} );
226 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
229 # XXX - FIXME - method is here now, move this crap...
230 around parameters => sub {
231 my ($orig, $self, $params) = @_;
233 if ( !ref $params ) {
234 $self->_context->log->warn(
235 "Attempt to retrieve '$params' with req->params(), " .
236 "you probably meant to call req->param('$params')"
240 return $self->$orig($params);
251 return $self->path if $self->has_uri;
256 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
258 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
259 # and provide a custom reader..
262 $self->prepare_body();
263 croak 'body is a reader' if scalar @_;
264 return blessed $self->_body ? $self->_body->body : $self->_body;
273 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
277 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
279 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
280 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
281 has user => (is => 'rw');
283 sub args { shift->arguments(@_) }
284 sub body_params { shift->body_parameters(@_) }
285 sub input { shift->body(@_) }
286 sub params { shift->parameters(@_) }
287 sub query_params { shift->query_parameters(@_) }
288 sub path_info { shift->path(@_) }
289 sub snippets { shift->captures(@_) }
291 =for stopwords param params
295 Catalyst::Request - provides information about the current client request
306 $req->body_parameters;
307 $req->content_encoding;
308 $req->content_length;
316 $req->query_keywords;
324 $req->query_parameters;
328 $req->captures; # previously knows as snippets
335 See also L<Catalyst>, L<Catalyst::Request::Upload>.
339 This is the Catalyst Request class, which provides an interface to data for the
340 current client request. The request object is prepared by L<Catalyst::Engine>,
341 thus hiding the details of the particular engine implementation.
347 [DEPRECATED] Returns the name of the requested action.
350 Use C<< $c->action >> instead (which returns a
351 L<Catalyst::Action|Catalyst::Action> object).
355 Returns the IP address of the client.
357 =head2 $req->arguments
359 Returns a reference to an array containing the arguments.
361 print $c->request->arguments->[0];
363 For example, if your action was
365 package MyApp::Controller::Foo;
371 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
372 would be the first and only argument.
374 Arguments get automatically URI-unescaped for you.
378 Shortcut for L</arguments>.
382 Contains the URI base. This will always have a trailing slash. Note that the
383 URI scheme (e.g., http vs. https) must be determined through heuristics;
384 depending on your server configuration, it may be incorrect. See $req->secure
387 If your application was queried with the URI
388 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
392 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
393 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
394 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
396 =head2 $req->body_parameters
398 Returns a reference to a hash containing body (POST) parameters. Values can
399 be either a scalar or an arrayref containing scalars.
401 print $c->request->body_parameters->{field};
402 print $c->request->body_parameters->{field}->[0];
404 These are the parameters from the POST part of the request, if any.
406 =head2 $req->body_params
408 Shortcut for body_parameters.
410 =head2 $req->content_encoding
412 Shortcut for $req->headers->content_encoding.
414 =head2 $req->content_length
416 Shortcut for $req->headers->content_length.
418 =head2 $req->content_type
420 Shortcut for $req->headers->content_type.
424 A convenient method to access $req->cookies.
426 $cookie = $c->request->cookie('name');
427 @cookies = $c->request->cookie;
435 return keys %{ $self->cookies };
442 unless ( exists $self->cookies->{$name} ) {
446 return $self->cookies->{$name};
452 Returns a reference to a hash containing the cookies.
454 print $c->request->cookies->{mycookie}->value;
456 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
461 Shortcut for $req->headers->header.
465 Returns an L<HTTP::Headers> object containing the headers for the current request.
467 print $c->request->headers->header('X-Catalyst');
469 =head2 $req->hostname
471 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
475 Alias for $req->body.
477 =head2 $req->query_keywords
479 Contains the keywords portion of a query string, when no '=' signs are
482 http://localhost/path?some+keywords
484 $c->request->query_keywords will contain 'some keywords'
488 This contains the matching part of a Regex action. Otherwise
489 it returns the same as 'action', except for default actions,
490 which return an empty string.
494 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
498 Returns GET and POST parameters with a CGI.pm-compatible param method. This
499 is an alternative method for accessing parameters in $c->req->parameters.
501 $value = $c->request->param( 'foo' );
502 @values = $c->request->param( 'foo' );
503 @params = $c->request->param;
505 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
506 arguments to this method, like this:
508 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
510 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
511 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
512 (creating it if it didn't exist before), and C<quxx> as another value for
515 B<NOTE> this is considered a legacy interface and care should be taken when
516 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
517 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
518 return a list of as many are present, which can have unexpected consequences
519 when writing code of the form:
523 baz => $c->req->param( 'baz' ),
526 If multiple C<baz> parameters are provided this code might corrupt data or
527 cause a hash initialization error. For a more straightforward interface see
528 C<< $c->req->parameters >>.
536 return keys %{ $self->parameters };
543 unless ( exists $self->parameters->{$param} ) {
544 return wantarray ? () : undef;
547 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
549 ? @{ $self->parameters->{$param} }
550 : $self->parameters->{$param}->[0];
554 ? ( $self->parameters->{$param} )
555 : $self->parameters->{$param};
560 $self->parameters->{$field} = [@_];
564 =head2 $req->parameters
566 Returns a reference to a hash containing GET and POST parameters. Values can
567 be either a scalar or an arrayref containing scalars.
569 print $c->request->parameters->{field};
570 print $c->request->parameters->{field}->[0];
572 This is the combination of C<query_parameters> and C<body_parameters>.
576 Shortcut for $req->parameters.
580 Returns the path, i.e. the part of the URI after $req->base, for the current request.
582 http://localhost/path/foo
584 $c->request->path will contain 'path/foo'
586 =head2 $req->path_info
588 Alias for path, added for compatibility with L<CGI>.
593 my ( $self, @params ) = @_;
596 $self->uri->path(@params);
599 elsif ( $self->_has_path ) {
603 my $path = $self->uri->path;
604 my $location = $self->base->path;
605 $path =~ s/^(\Q$location\E)?//;
613 =head2 $req->protocol
615 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
617 =head2 $req->query_parameters
619 =head2 $req->query_params
621 Returns a reference to a hash containing query string (GET) parameters. Values can
622 be either a scalar or an arrayref containing scalars.
624 print $c->request->query_parameters->{field};
625 print $c->request->query_parameters->{field}->[0];
627 =head2 $req->read( [$maxlength] )
629 Reads a chunk of data from the request body. This method is intended to be
630 used in a while loop, reading $maxlength bytes on every call. $maxlength
631 defaults to the size of the request if not specified.
633 =head2 $req->read_chunk(\$buff, $max)
637 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
641 Shortcut for $req->headers->referer. Returns the referring page.
645 Returns true or false, indicating whether the connection is secure
646 (https). Note that the URI scheme (e.g., http vs. https) must be determined
647 through heuristics, and therefore the reliability of $req->secure will depend
648 on your server configuration. If you are serving secure pages on the standard
649 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
652 =head2 $req->captures
654 Returns a reference to an array containing captured args from chained
655 actions or regex captures.
657 my @captures = @{ $c->request->captures };
659 =head2 $req->snippets
661 C<captures> used to be called snippets. This is still available for backwards
662 compatibility, but is considered deprecated.
666 A convenient method to access $req->uploads.
668 $upload = $c->request->upload('field');
669 @uploads = $c->request->upload('field');
670 @fields = $c->request->upload;
672 for my $upload ( $c->request->upload('field') ) {
673 print $upload->filename;
682 return keys %{ $self->uploads };
689 unless ( exists $self->uploads->{$upload} ) {
690 return wantarray ? () : undef;
693 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
695 ? @{ $self->uploads->{$upload} }
696 : $self->uploads->{$upload}->[0];
700 ? ( $self->uploads->{$upload} )
701 : $self->uploads->{$upload};
707 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
709 if ( exists $self->uploads->{$field} ) {
710 for ( $self->uploads->{$field} ) {
711 $_ = [$_] unless ref($_) eq "ARRAY";
712 push( @$_, $upload );
716 $self->uploads->{$field} = $upload;
724 Returns a reference to a hash containing uploads. Values can be either a
725 L<Catalyst::Request::Upload> object, or an arrayref of
726 L<Catalyst::Request::Upload> objects.
728 my $upload = $c->request->uploads->{field};
729 my $upload = $c->request->uploads->{field}->[0];
733 Returns a L<URI> object for the current request. Stringifies to the URI text.
735 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
737 Returns a hashref of parameters stemming from the current request's params,
738 plus the ones supplied. Keys for which no current param exists will be
739 added, keys with undefined values will be removed and keys with existing
740 params will be replaced. Note that you can supply a true value as the final
741 argument to change behavior with regards to existing parameters, appending
742 values rather than replacing them.
746 # URI query params foo=1
747 my $hashref = $req->mangle_params({ foo => 2 });
748 # Result is query params of foo=2
752 # URI query params foo=1
753 my $hashref = $req->mangle_params({ foo => 2 }, 1);
754 # Result is query params of foo=1&foo=2
756 This is the code behind C<uri_with>.
761 my ($self, $args, $append) = @_;
763 carp('No arguments passed to mangle_params()') unless $args;
765 foreach my $value ( values %$args ) {
766 next unless defined $value;
767 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
769 utf8::encode( $_ ) if utf8::is_utf8($_);
773 my %params = %{ $self->uri->query_form_hash };
774 foreach my $key (keys %{ $args }) {
775 my $val = $args->{$key};
778 if($append && exists($params{$key})) {
780 # This little bit of heaven handles appending a new value onto
781 # an existing one regardless if the existing value is an array
782 # or not, and regardless if the new value is an array or not
784 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
785 ref($val) eq 'ARRAY' ? @{ $val } : $val
789 $params{$key} = $val;
793 # If the param wasn't defined then we delete it.
794 delete($params{$key});
802 =head2 $req->uri_with( { key => 'value' } );
804 Returns a rewritten URI object for the current request. Key/value pairs
805 passed in will override existing parameters. You can remove an existing
806 parameter by passing in an undef value. Unmodified pairs will be
809 You may also pass an optional second parameter that puts C<uri_with> into
812 $req->uri_with( { key => 'value' }, { mode => 'append' } );
814 See C<mangle_params> for an explanation of this behavior.
819 my( $self, $args, $behavior) = @_;
821 carp( 'No arguments passed to uri_with()' ) unless $args;
824 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
828 my $params = $self->mangle_params($args, $append);
830 my $uri = $self->uri->clone;
831 $uri->query_form($params);
836 =head2 $req->remote_user
838 Returns the value of the C<REMOTE_USER> environment variable.
840 =head2 $req->user_agent
842 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
851 Catalyst Contributors, see Catalyst.pm
855 This library is free software. You can redistribute it and/or modify
856 it under the same terms as Perl itself.
860 __PACKAGE__->meta->make_immutable;