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). The reliability of $req->secure may depend on your server
655 configuration; Catalyst relies on PSGI to determine whether or not a
656 request is secure (Catalyst looks at psgi.url_scheme), and different
657 PSGI servers may make this determination in different ways (as by
658 directly passing along information from the server, interpreting any of
659 several HTTP headers, or using heuristics of their own).
661 =head2 $req->captures
663 Returns a reference to an array containing captured args from chained
664 actions or regex captures.
666 my @captures = @{ $c->request->captures };
670 A convenient method to access $req->uploads.
672 $upload = $c->request->upload('field');
673 @uploads = $c->request->upload('field');
674 @fields = $c->request->upload;
676 for my $upload ( $c->request->upload('field') ) {
677 print $upload->filename;
686 return keys %{ $self->uploads };
693 unless ( exists $self->uploads->{$upload} ) {
694 return wantarray ? () : undef;
697 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
699 ? @{ $self->uploads->{$upload} }
700 : $self->uploads->{$upload}->[0];
704 ? ( $self->uploads->{$upload} )
705 : $self->uploads->{$upload};
711 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
713 if ( exists $self->uploads->{$field} ) {
714 for ( $self->uploads->{$field} ) {
715 $_ = [$_] unless ref($_) eq "ARRAY";
716 push( @$_, $upload );
720 $self->uploads->{$field} = $upload;
728 Returns a reference to a hash containing uploads. Values can be either a
729 L<Catalyst::Request::Upload> object, or an arrayref of
730 L<Catalyst::Request::Upload> objects.
732 my $upload = $c->request->uploads->{field};
733 my $upload = $c->request->uploads->{field}->[0];
737 Returns a L<URI> object for the current request. Stringifies to the URI text.
739 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
741 Returns a hashref of parameters stemming from the current request's params,
742 plus the ones supplied. Keys for which no current param exists will be
743 added, keys with undefined values will be removed and keys with existing
744 params will be replaced. Note that you can supply a true value as the final
745 argument to change behavior with regards to existing parameters, appending
746 values rather than replacing them.
750 # URI query params foo=1
751 my $hashref = $req->mangle_params({ foo => 2 });
752 # Result is query params of foo=2
756 # URI query params foo=1
757 my $hashref = $req->mangle_params({ foo => 2 }, 1);
758 # Result is query params of foo=1&foo=2
760 This is the code behind C<uri_with>.
765 my ($self, $args, $append) = @_;
767 carp('No arguments passed to mangle_params()') unless $args;
769 foreach my $value ( values %$args ) {
770 next unless defined $value;
771 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
773 utf8::encode( $_ ) if utf8::is_utf8($_);
777 my %params = %{ $self->uri->query_form_hash };
778 foreach my $key (keys %{ $args }) {
779 my $val = $args->{$key};
782 if($append && exists($params{$key})) {
784 # This little bit of heaven handles appending a new value onto
785 # an existing one regardless if the existing value is an array
786 # or not, and regardless if the new value is an array or not
788 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
789 ref($val) eq 'ARRAY' ? @{ $val } : $val
793 $params{$key} = $val;
797 # If the param wasn't defined then we delete it.
798 delete($params{$key});
806 =head2 $req->uri_with( { key => 'value' } );
808 Returns a rewritten URI object for the current request. Key/value pairs
809 passed in will override existing parameters. You can remove an existing
810 parameter by passing in an undef value. Unmodified pairs will be
813 You may also pass an optional second parameter that puts C<uri_with> into
816 $req->uri_with( { key => 'value' }, { mode => 'append' } );
818 See C<mangle_params> for an explanation of this behavior.
823 my( $self, $args, $behavior) = @_;
825 carp( 'No arguments passed to uri_with()' ) unless $args;
828 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
832 my $params = $self->mangle_params($args, $append);
834 my $uri = $self->uri->clone;
835 $uri->query_form($params);
840 =head2 $req->remote_user
842 Returns the value of the C<REMOTE_USER> environment variable.
844 =head2 $req->user_agent
846 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
851 You should never need to call these yourself in application code,
852 however they are useful if extending Catalyst by applying a request role.
854 =head2 $self->prepare_headers()
856 Sets up the C<< $res->headers >> accessor.
858 =head2 $self->prepare_body()
860 Sets up the body using L<HTTP::Body>
862 =head2 $self->prepare_body_chunk()
864 Add a chunk to the request body.
866 =head2 $self->prepare_body_parameters()
868 Sets up parameters from body.
870 =head2 $self->prepare_cookies()
872 Parse cookies from header. Sets up a L<CGI::Simple::Cookie> object.
874 =head2 $self->prepare_connection()
876 Sets up various fields in the request like the local and remote addresses,
877 request method, hostname requested etc.
879 =head2 $self->prepare_parameters()
881 Ensures that the body has been parsed, then builds the parameters, which are
882 combined from those in the request and those in the body.
884 If parameters have already been set will clear the parameters and build them again.
893 Catalyst Contributors, see Catalyst.pm
897 This library is free software. You can redistribute it and/or modify
898 it under the same terms as Perl itself.
902 __PACKAGE__->meta->make_immutable;