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');
18 # XXX Deprecated crap here - warn?
19 has action => (is => 'rw');
20 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
21 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
22 has user => (is => 'rw');
23 sub snippets { shift->captures(@_) }
25 has _read_position => (
26 # FIXME: work around Moose bug RT#75367
29 writer => '_set_read_position',
33 # FIXME: work around Moose bug RT#75367
38 $self->header('Content-Length') || 0;
43 has address => (is => 'rw');
44 has arguments => (is => 'rw', default => sub { [] });
45 has cookies => (is => 'ro', builder => 'prepare_cookies', lazy => 1);
50 if ( my $header = $self->header('Cookie') ) {
51 return { CGI::Simple::Cookie->parse($header) };
56 has query_keywords => (is => 'rw');
57 has match => (is => 'rw');
58 has method => (is => 'rw');
59 has protocol => (is => 'rw');
60 has query_parameters => (is => 'rw', default => sub { {} });
61 has secure => (is => 'rw', default => 0);
62 has captures => (is => 'rw', default => sub { [] });
63 has uri => (is => 'rw', predicate => 'has_uri');
64 has remote_user => (is => 'rw');
67 isa => 'HTTP::Headers',
68 handles => [qw(content_encoding content_length content_type header referer user_agent)],
69 builder => 'prepare_headers',
77 my $headers = HTTP::Headers->new();
79 for my $header (keys %{ $env }) {
80 next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
81 (my $field = $header) =~ s/^HTTPS?_//;
83 $headers->header($field => $env->{$header});
94 # Amount of data to read from input on each pass
95 our $CHUNKSIZE = 64 * 1024;
98 my ($self, $maxlength) = @_;
99 my $remaining = $self->_read_length - $self->_read_position;
100 $maxlength ||= $CHUNKSIZE;
102 # Are we done reading?
103 if ( $remaining <= 0 ) {
107 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
108 my $rc = $self->read_chunk( my $buffer, $readlen );
110 if (0 == $rc) { # Nothing more to read even though Content-Length
111 # said there should be.
114 $self->_set_read_position( $self->_read_position + $rc );
118 Catalyst::Exception->throw(
119 message => "Unknown error reading input: $!" );
125 return $self->env->{'psgi.input'}->read(@_);
128 has body_parameters => (
132 builder => 'prepare_body_parameters',
138 default => sub { {} },
144 builder => '_build_parameters',
145 clearer => '_clear_parameters',
149 # - Can we lose the before modifiers which just call prepare_body ?
150 # they are wasteful, slow us down and feel cluttery.
152 # Can we make _body an attribute, have the rest of
153 # these lazy build from there and kill all the direct hash access
154 # in Catalyst.pm and Engine.pm?
156 sub prepare_parameters {
158 $self->_clear_parameters;
159 return $self->parameters;
164 sub _build_parameters {
167 my $body_parameters = $self->body_parameters;
168 my $query_parameters = $self->query_parameters;
169 # We copy, no references
170 foreach my $name (keys %$query_parameters) {
171 my $param = $query_parameters->{$name};
172 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
175 # Merge query and body parameters
176 foreach my $name (keys %$body_parameters) {
177 my $param = $body_parameters->{$name};
178 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
179 if ( my $existing = $parameters->{$name} ) {
180 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
182 $parameters->{$name} = @values > 1 ? \@values : $values[0];
189 predicate => '_has_uploadtmp',
195 if ( my $length = $self->_read_length ) {
196 unless ( $self->_body ) {
197 my $type = $self->header('Content-Type');
198 $self->_body(HTTP::Body->new( $type, $length ));
199 $self->_body->cleanup(1); # Make extra sure!
200 $self->_body->tmpdir( $self->_uploadtmp )
201 if $self->_has_uploadtmp;
204 # Check for definedness as you could read '0'
205 while ( defined ( my $buffer = $self->read() ) ) {
206 $self->prepare_body_chunk($buffer);
209 # paranoia against wrong Content-Length header
210 my $remaining = $length - $self->_read_position;
211 if ( $remaining > 0 ) {
212 Catalyst::Exception->throw(
213 "Wrong Content-Length value: $length" );
217 # Defined but will cause all body code to be skipped
222 sub prepare_body_chunk {
223 my ( $self, $chunk ) = @_;
225 $self->_body->add($chunk);
228 sub prepare_body_parameters {
231 $self->prepare_body if ! $self->_has_body;
232 return {} unless $self->_body;
234 return $self->_body->param;
237 sub prepare_connection {
240 my $env = $self->env;
242 $self->address( $env->{REMOTE_ADDR} );
243 $self->hostname( $env->{REMOTE_HOST} )
244 if exists $env->{REMOTE_HOST};
245 $self->protocol( $env->{SERVER_PROTOCOL} );
246 $self->remote_user( $env->{REMOTE_USER} );
247 $self->method( $env->{REQUEST_METHOD} );
248 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
251 # XXX - FIXME - method is here now, move this crap...
252 around parameters => sub {
253 my ($orig, $self, $params) = @_;
255 if ( !ref $params ) {
257 "Attempt to retrieve '$params' with req->params(), " .
258 "you probably meant to call req->param('$params')"
262 return $self->$orig($params);
273 return $self->path if $self->has_uri;
278 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
280 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
281 # and provide a custom reader..
284 $self->prepare_body unless ! $self->_has_body;
285 croak 'body is a reader' if scalar @_;
286 return blessed $self->_body ? $self->_body->body : $self->_body;
295 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
299 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
301 sub args { shift->arguments(@_) }
302 sub body_params { shift->body_parameters(@_) }
303 sub input { shift->body(@_) }
304 sub params { shift->parameters(@_) }
305 sub query_params { shift->query_parameters(@_) }
306 sub path_info { shift->path(@_) }
308 =for stopwords param params
312 Catalyst::Request - provides information about the current client request
317 $req->address eq "127.0.0.1";
322 $req->body_parameters;
323 $req->content_encoding;
324 $req->content_length;
332 $req->query_keywords;
340 $req->query_parameters;
351 See also L<Catalyst>, L<Catalyst::Request::Upload>.
355 This is the Catalyst Request class, which provides an interface to data for the
356 current client request. The request object is prepared by L<Catalyst::Engine>,
357 thus hiding the details of the particular engine implementation.
363 Returns the IP address of the client.
365 =head2 $req->arguments
367 Returns a reference to an array containing the arguments.
369 print $c->request->arguments->[0];
371 For example, if your action was
373 package MyApp::Controller::Foo;
379 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
380 would be the first and only argument.
382 Arguments get automatically URI-unescaped for you.
386 Shortcut for L</arguments>.
390 Contains the URI base. This will always have a trailing slash. Note that the
391 URI scheme (e.g., http vs. https) must be determined through heuristics;
392 depending on your server configuration, it may be incorrect. See $req->secure
395 If your application was queried with the URI
396 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
400 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
401 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
402 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
404 =head2 $req->body_parameters
406 Returns a reference to a hash containing body (POST) parameters. Values can
407 be either a scalar or an arrayref containing scalars.
409 print $c->request->body_parameters->{field};
410 print $c->request->body_parameters->{field}->[0];
412 These are the parameters from the POST part of the request, if any.
414 =head2 $req->body_params
416 Shortcut for body_parameters.
418 =head2 $req->content_encoding
420 Shortcut for $req->headers->content_encoding.
422 =head2 $req->content_length
424 Shortcut for $req->headers->content_length.
426 =head2 $req->content_type
428 Shortcut for $req->headers->content_type.
432 A convenient method to access $req->cookies.
434 $cookie = $c->request->cookie('name');
435 @cookies = $c->request->cookie;
443 return keys %{ $self->cookies };
450 unless ( exists $self->cookies->{$name} ) {
454 return $self->cookies->{$name};
460 Returns a reference to a hash containing the cookies.
462 print $c->request->cookies->{mycookie}->value;
464 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
469 Shortcut for $req->headers->header.
473 Returns an L<HTTP::Headers> object containing the headers for the current request.
475 print $c->request->headers->header('X-Catalyst');
477 =head2 $req->hostname
479 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
483 Alias for $req->body.
485 =head2 $req->query_keywords
487 Contains the keywords portion of a query string, when no '=' signs are
490 http://localhost/path?some+keywords
492 $c->request->query_keywords will contain 'some keywords'
496 This contains the matching part of a Regex action. Otherwise
497 it returns the same as 'action', except for default actions,
498 which return an empty string.
502 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
506 Returns GET and POST parameters with a CGI.pm-compatible param method. This
507 is an alternative method for accessing parameters in $c->req->parameters.
509 $value = $c->request->param( 'foo' );
510 @values = $c->request->param( 'foo' );
511 @params = $c->request->param;
513 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
514 arguments to this method, like this:
516 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
518 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
519 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
520 (creating it if it didn't exist before), and C<quxx> as another value for
523 B<NOTE> this is considered a legacy interface and care should be taken when
524 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
525 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
526 return a list of as many are present, which can have unexpected consequences
527 when writing code of the form:
531 baz => $c->req->param( 'baz' ),
534 If multiple C<baz> parameters are provided this code might corrupt data or
535 cause a hash initialization error. For a more straightforward interface see
536 C<< $c->req->parameters >>.
544 return keys %{ $self->parameters };
551 unless ( exists $self->parameters->{$param} ) {
552 return wantarray ? () : undef;
555 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
557 ? @{ $self->parameters->{$param} }
558 : $self->parameters->{$param}->[0];
562 ? ( $self->parameters->{$param} )
563 : $self->parameters->{$param};
568 $self->parameters->{$field} = [@_];
572 =head2 $req->parameters
574 Returns a reference to a hash containing GET and POST parameters. Values can
575 be either a scalar or an arrayref containing scalars.
577 print $c->request->parameters->{field};
578 print $c->request->parameters->{field}->[0];
580 This is the combination of C<query_parameters> and C<body_parameters>.
584 Shortcut for $req->parameters.
588 Returns the path, i.e. the part of the URI after $req->base, for the current request.
590 http://localhost/path/foo
592 $c->request->path will contain 'path/foo'
594 =head2 $req->path_info
596 Alias for path, added for compatibility with L<CGI>.
601 my ( $self, @params ) = @_;
604 $self->uri->path(@params);
607 elsif ( $self->_has_path ) {
611 my $path = $self->uri->path;
612 my $location = $self->base->path;
613 $path =~ s/^(\Q$location\E)?//;
621 =head2 $req->protocol
623 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
625 =head2 $req->query_parameters
627 =head2 $req->query_params
629 Returns a reference to a hash containing query string (GET) parameters. Values can
630 be either a scalar or an arrayref containing scalars.
632 print $c->request->query_parameters->{field};
633 print $c->request->query_parameters->{field}->[0];
635 =head2 $req->read( [$maxlength] )
637 Reads a chunk of data from the request body. This method is intended to be
638 used in a while loop, reading $maxlength bytes on every call. $maxlength
639 defaults to the size of the request if not specified.
641 =head2 $req->read_chunk(\$buff, $max)
645 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
649 Shortcut for $req->headers->referer. Returns the referring page.
653 Returns true or false, indicating whether the connection is secure
654 (https). Note that the URI scheme (e.g., http vs. https) must be determined
655 through heuristics, and therefore the reliability of $req->secure will depend
656 on your server configuration. If you are setting the HTTPS environment variable,
657 $req->secure should be valid.
659 =head2 $req->captures
661 Returns a reference to an array containing captured args from chained
662 actions or regex captures.
664 my @captures = @{ $c->request->captures };
668 A convenient method to access $req->uploads.
670 $upload = $c->request->upload('field');
671 @uploads = $c->request->upload('field');
672 @fields = $c->request->upload;
674 for my $upload ( $c->request->upload('field') ) {
675 print $upload->filename;
684 return keys %{ $self->uploads };
691 unless ( exists $self->uploads->{$upload} ) {
692 return wantarray ? () : undef;
695 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
697 ? @{ $self->uploads->{$upload} }
698 : $self->uploads->{$upload}->[0];
702 ? ( $self->uploads->{$upload} )
703 : $self->uploads->{$upload};
709 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
711 if ( exists $self->uploads->{$field} ) {
712 for ( $self->uploads->{$field} ) {
713 $_ = [$_] unless ref($_) eq "ARRAY";
714 push( @$_, $upload );
718 $self->uploads->{$field} = $upload;
726 Returns a reference to a hash containing uploads. Values can be either a
727 L<Catalyst::Request::Upload> object, or an arrayref of
728 L<Catalyst::Request::Upload> objects.
730 my $upload = $c->request->uploads->{field};
731 my $upload = $c->request->uploads->{field}->[0];
735 Returns a L<URI> object for the current request. Stringifies to the URI text.
737 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
739 Returns a hashref of parameters stemming from the current request's params,
740 plus the ones supplied. Keys for which no current param exists will be
741 added, keys with undefined values will be removed and keys with existing
742 params will be replaced. Note that you can supply a true value as the final
743 argument to change behavior with regards to existing parameters, appending
744 values rather than replacing them.
748 # URI query params foo=1
749 my $hashref = $req->mangle_params({ foo => 2 });
750 # Result is query params of foo=2
754 # URI query params foo=1
755 my $hashref = $req->mangle_params({ foo => 2 }, 1);
756 # Result is query params of foo=1&foo=2
758 This is the code behind C<uri_with>.
763 my ($self, $args, $append) = @_;
765 carp('No arguments passed to mangle_params()') unless $args;
767 foreach my $value ( values %$args ) {
768 next unless defined $value;
769 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
771 utf8::encode( $_ ) if utf8::is_utf8($_);
775 my %params = %{ $self->uri->query_form_hash };
776 foreach my $key (keys %{ $args }) {
777 my $val = $args->{$key};
780 if($append && exists($params{$key})) {
782 # This little bit of heaven handles appending a new value onto
783 # an existing one regardless if the existing value is an array
784 # or not, and regardless if the new value is an array or not
786 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
787 ref($val) eq 'ARRAY' ? @{ $val } : $val
791 $params{$key} = $val;
795 # If the param wasn't defined then we delete it.
796 delete($params{$key});
804 =head2 $req->uri_with( { key => 'value' } );
806 Returns a rewritten URI object for the current request. Key/value pairs
807 passed in will override existing parameters. You can remove an existing
808 parameter by passing in an undef value. Unmodified pairs will be
811 You may also pass an optional second parameter that puts C<uri_with> into
814 $req->uri_with( { key => 'value' }, { mode => 'append' } );
816 See C<mangle_params> for an explanation of this behavior.
821 my( $self, $args, $behavior) = @_;
823 carp( 'No arguments passed to uri_with()' ) unless $args;
826 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
830 my $params = $self->mangle_params($args, $append);
832 my $uri = $self->uri->clone;
833 $uri->query_form($params);
838 =head2 $req->remote_user
840 Returns the value of the C<REMOTE_USER> environment variable.
842 =head2 $req->user_agent
844 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
849 You should never need to call these yourself in application code,
850 however they are useful if extending Catalyst by applying a request role.
852 =head2 $self->prepare_headers()
854 Sets up the C<< $res->headers >> accessor.
856 =head2 $self->prepare_body()
858 Sets up the body using L<HTTP::Body>
860 =head2 $self->prepare_body_chunk()
862 Add a chunk to the request body.
864 =head2 $self->prepare_body_parameters()
866 Sets up parameters from body.
868 =head2 $self->prepare_cookies()
870 Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
872 =head2 $self->prepare_connection()
874 Sets up various fields in the request like the local and remote addresses,
875 request method, hostname requested etc.
877 =head2 $self->prepare_parameters()
879 Ensures that the body has been parsed, then builds the parameters, which are
880 combined from those in the request and those in the body.
882 If parameters have already been set will clear the parameters and build them again.
891 Catalyst Contributors, see Catalyst.pm
895 This library is free software. You can redistribute it and/or modify
896 it under the same terms as Perl itself.
900 __PACKAGE__->meta->make_immutable;