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 => 'ro', builder => 'prepare_cookies', lazy => 1);
33 =head2 $self->prepare_cookies($c)
35 Parse cookies from header. Sets a L<CGI::Simple::Cookie> object.
42 if ( my $header = $self->header('Cookie') ) {
43 return { CGI::Simple::Cookie->parse($header) };
48 has query_keywords => (is => 'rw');
49 has match => (is => 'rw');
50 has method => (is => 'rw');
51 has protocol => (is => 'rw');
52 has query_parameters => (is => 'rw', default => sub { {} });
53 has secure => (is => 'rw', default => 0);
54 has captures => (is => 'rw', default => sub { [] });
55 has uri => (is => 'rw', predicate => 'has_uri');
56 has remote_user => (is => 'rw');
59 isa => 'HTTP::Headers',
60 handles => [qw(content_encoding content_length content_type header referer user_agent)],
61 builder => 'prepare_headers',
65 =head2 $self->prepare_headers($c)
73 my $headers = HTTP::Headers->new();
75 for my $header (keys %{ $env }) {
76 next unless $header =~ /^(HTTP|CONTENT|COOKIE)/i;
77 (my $field = $header) =~ s/^HTTPS?_//;
79 $headers->header($field => $env->{$header});
87 clearer => '_clear_context',
90 # Amount of data to read from input on each pass
91 our $CHUNKSIZE = 64 * 1024;
94 my ($self, $maxlength) = @_;
95 my $remaining = $self->_read_length - $self->_read_position;
96 $maxlength ||= $CHUNKSIZE;
98 # Are we done reading?
99 if ( $remaining <= 0 ) {
103 my $readlen = ( $remaining > $maxlength ) ? $maxlength : $remaining;
104 my $rc = $self->read_chunk( my $buffer, $readlen );
106 if (0 == $rc) { # Nothing more to read even though Content-Length
107 # said there should be.
110 $self->_read_position( $self->_read_position + $rc );
114 Catalyst::Exception->throw(
115 message => "Unknown error reading input: $!" );
121 return $self->env->{'psgi.input'}->read(@_);
124 has body_parameters => (
128 default => sub { {} },
134 default => sub { {} },
140 builder => 'prepare_parameters',
144 # - Can we lose the before modifiers which just call prepare_body ?
145 # they are wasteful, slow us down and feel cluttery.
147 # Can we make _body an attribute, have the rest of
148 # these lazy build from there and kill all the direct hash access
149 # in Catalyst.pm and Engine.pm?
151 sub prepare_parameters {
156 my $body_parameters = $self->body_parameters;
157 my $query_parameters = $self->query_parameters;
158 # We copy, no references
159 foreach my $name (keys %$query_parameters) {
160 my $param = $query_parameters->{$name};
161 $parameters->{$name} = ref $param eq 'ARRAY' ? [ @$param ] : $param;
164 # Merge query and body parameters
165 foreach my $name (keys %$body_parameters) {
166 my $param = $body_parameters->{$name};
167 my @values = ref $param eq 'ARRAY' ? @$param : ($param);
168 if ( my $existing = $parameters->{$name} ) {
169 unshift(@values, (ref $existing eq 'ARRAY' ? @$existing : $existing));
171 $parameters->{$name} = @values > 1 ? \@values : $values[0];
176 before body_parameters => sub {
179 $self->prepare_body_parameters;
182 =head2 $self->prepare_body()
184 sets up the L<Catalyst::Request> object body using L<HTTP::Body>
190 predicate => '_has_uploadtmp',
196 if ( my $length = $self->_read_length ) {
197 unless ( $self->_body ) {
198 my $type = $self->header('Content-Type');
199 $self->_body(HTTP::Body->new( $type, $length ));
200 $self->_body->cleanup(1); # Make extra sure!
201 $self->_body->tmpdir( $self->_uploadtmp )
202 if $self->_has_uploadtmp;
205 # Check for definedness as you could read '0'
206 while ( defined ( my $buffer = $self->read() ) ) {
207 $self->prepare_body_chunk($buffer);
210 # paranoia against wrong Content-Length header
211 my $remaining = $length - $self->_read_position;
212 if ( $remaining > 0 ) {
213 Catalyst::Exception->throw(
214 "Wrong Content-Length value: $length" );
218 # Defined but will cause all body code to be skipped
223 =head2 $self->prepare_body_chunk()
225 Add a chunk to the request body.
229 sub prepare_body_chunk {
230 my ( $self, $chunk ) = @_;
232 $self->_body->add($chunk);
235 =head2 $self->prepare_body_parameters()
237 Sets up parameters from body.
241 sub prepare_body_parameters {
244 return unless $self->_body;
246 $self->{body_parameters} = $self->_body->param; # FIXME!! Recursion here.
249 sub prepare_connection {
252 my $env = $self->env;
254 $self->address( $env->{REMOTE_ADDR} );
255 $self->hostname( $env->{REMOTE_HOST} )
256 if exists $env->{REMOTE_HOST};
257 $self->protocol( $env->{SERVER_PROTOCOL} );
258 $self->remote_user( $env->{REMOTE_USER} );
259 $self->method( $env->{REQUEST_METHOD} );
260 $self->secure( $env->{'psgi.url_scheme'} eq 'https' ? 1 : 0 );
263 # XXX - FIXME - method is here now, move this crap...
264 around parameters => sub {
265 my ($orig, $self, $params) = @_;
267 if ( !ref $params ) {
268 $self->_context->log->warn(
269 "Attempt to retrieve '$params' with req->params(), " .
270 "you probably meant to call req->param('$params')"
274 return $self->$orig($params);
285 return $self->path if $self->has_uri;
290 is => 'rw', clearer => '_clear_body', predicate => '_has_body',
292 # Eugh, ugly. Should just be able to rename accessor methods to 'body'
293 # and provide a custom reader..
296 $self->prepare_body();
297 croak 'body is a reader' if scalar @_;
298 return blessed $self->_body ? $self->_body->body : $self->_body;
307 gethostbyaddr( inet_aton( $self->address ), AF_INET ) || $self->address
311 has _path => ( is => 'rw', predicate => '_has_path', clearer => '_clear_path' );
313 # XXX: Deprecated in docs ages ago (2006), deprecated with warning in 5.8000 due
314 # to confusion between Engines and Plugin::Authentication. Remove in 5.8100?
315 has user => (is => 'rw');
317 sub args { shift->arguments(@_) }
318 sub body_params { shift->body_parameters(@_) }
319 sub input { shift->body(@_) }
320 sub params { shift->parameters(@_) }
321 sub query_params { shift->query_parameters(@_) }
322 sub path_info { shift->path(@_) }
323 sub snippets { shift->captures(@_) }
325 =for stopwords param params
329 Catalyst::Request - provides information about the current client request
340 $req->body_parameters;
341 $req->content_encoding;
342 $req->content_length;
350 $req->query_keywords;
358 $req->query_parameters;
362 $req->captures; # previously knows as snippets
369 See also L<Catalyst>, L<Catalyst::Request::Upload>.
373 This is the Catalyst Request class, which provides an interface to data for the
374 current client request. The request object is prepared by L<Catalyst::Engine>,
375 thus hiding the details of the particular engine implementation.
381 [DEPRECATED] Returns the name of the requested action.
384 Use C<< $c->action >> instead (which returns a
385 L<Catalyst::Action|Catalyst::Action> object).
389 Returns the IP address of the client.
391 =head2 $req->arguments
393 Returns a reference to an array containing the arguments.
395 print $c->request->arguments->[0];
397 For example, if your action was
399 package MyApp::Controller::Foo;
405 and the URI for the request was C<http://.../foo/moose/bah>, the string C<bah>
406 would be the first and only argument.
408 Arguments get automatically URI-unescaped for you.
412 Shortcut for L</arguments>.
416 Contains the URI base. This will always have a trailing slash. Note that the
417 URI scheme (e.g., http vs. https) must be determined through heuristics;
418 depending on your server configuration, it may be incorrect. See $req->secure
421 If your application was queried with the URI
422 C<http://localhost:3000/some/path> then C<base> is C<http://localhost:3000/>.
426 Returns the message body of the request, as returned by L<HTTP::Body>: a string,
427 unless Content-Type is C<application/x-www-form-urlencoded>, C<text/xml>, or
428 C<multipart/form-data>, in which case a L<File::Temp> object is returned.
430 =head2 $req->body_parameters
432 Returns a reference to a hash containing body (POST) parameters. Values can
433 be either a scalar or an arrayref containing scalars.
435 print $c->request->body_parameters->{field};
436 print $c->request->body_parameters->{field}->[0];
438 These are the parameters from the POST part of the request, if any.
440 =head2 $req->body_params
442 Shortcut for body_parameters.
444 =head2 $req->content_encoding
446 Shortcut for $req->headers->content_encoding.
448 =head2 $req->content_length
450 Shortcut for $req->headers->content_length.
452 =head2 $req->content_type
454 Shortcut for $req->headers->content_type.
458 A convenient method to access $req->cookies.
460 $cookie = $c->request->cookie('name');
461 @cookies = $c->request->cookie;
469 return keys %{ $self->cookies };
476 unless ( exists $self->cookies->{$name} ) {
480 return $self->cookies->{$name};
486 Returns a reference to a hash containing the cookies.
488 print $c->request->cookies->{mycookie}->value;
490 The cookies in the hash are indexed by name, and the values are L<CGI::Simple::Cookie>
495 Shortcut for $req->headers->header.
499 Returns an L<HTTP::Headers> object containing the headers for the current request.
501 print $c->request->headers->header('X-Catalyst');
503 =head2 $req->hostname
505 Returns the hostname of the client. Use C<< $req->uri->host >> to get the hostname of the server.
509 Alias for $req->body.
511 =head2 $req->query_keywords
513 Contains the keywords portion of a query string, when no '=' signs are
516 http://localhost/path?some+keywords
518 $c->request->query_keywords will contain 'some keywords'
522 This contains the matching part of a Regex action. Otherwise
523 it returns the same as 'action', except for default actions,
524 which return an empty string.
528 Contains the request method (C<GET>, C<POST>, C<HEAD>, etc).
532 Returns GET and POST parameters with a CGI.pm-compatible param method. This
533 is an alternative method for accessing parameters in $c->req->parameters.
535 $value = $c->request->param( 'foo' );
536 @values = $c->request->param( 'foo' );
537 @params = $c->request->param;
539 Like L<CGI>, and B<unlike> earlier versions of Catalyst, passing multiple
540 arguments to this method, like this:
542 $c->request->param( 'foo', 'bar', 'gorch', 'quxx' );
544 will set the parameter C<foo> to the multiple values C<bar>, C<gorch> and
545 C<quxx>. Previously this would have added C<bar> as another value to C<foo>
546 (creating it if it didn't exist before), and C<quxx> as another value for
549 B<NOTE> this is considered a legacy interface and care should be taken when
550 using it. C<< scalar $c->req->param( 'foo' ) >> will return only the first
551 C<foo> param even if multiple are present; C<< $c->req->param( 'foo' ) >> will
552 return a list of as many are present, which can have unexpected consequences
553 when writing code of the form:
557 baz => $c->req->param( 'baz' ),
560 If multiple C<baz> parameters are provided this code might corrupt data or
561 cause a hash initialization error. For a more straightforward interface see
562 C<< $c->req->parameters >>.
570 return keys %{ $self->parameters };
577 unless ( exists $self->parameters->{$param} ) {
578 return wantarray ? () : undef;
581 if ( ref $self->parameters->{$param} eq 'ARRAY' ) {
583 ? @{ $self->parameters->{$param} }
584 : $self->parameters->{$param}->[0];
588 ? ( $self->parameters->{$param} )
589 : $self->parameters->{$param};
594 $self->parameters->{$field} = [@_];
598 =head2 $req->parameters
600 Returns a reference to a hash containing GET and POST parameters. Values can
601 be either a scalar or an arrayref containing scalars.
603 print $c->request->parameters->{field};
604 print $c->request->parameters->{field}->[0];
606 This is the combination of C<query_parameters> and C<body_parameters>.
610 Shortcut for $req->parameters.
614 Returns the path, i.e. the part of the URI after $req->base, for the current request.
616 http://localhost/path/foo
618 $c->request->path will contain 'path/foo'
620 =head2 $req->path_info
622 Alias for path, added for compatibility with L<CGI>.
627 my ( $self, @params ) = @_;
630 $self->uri->path(@params);
633 elsif ( $self->_has_path ) {
637 my $path = $self->uri->path;
638 my $location = $self->base->path;
639 $path =~ s/^(\Q$location\E)?//;
647 =head2 $req->protocol
649 Returns the protocol (HTTP/1.0 or HTTP/1.1) used for the current request.
651 =head2 $req->query_parameters
653 =head2 $req->query_params
655 Returns a reference to a hash containing query string (GET) parameters. Values can
656 be either a scalar or an arrayref containing scalars.
658 print $c->request->query_parameters->{field};
659 print $c->request->query_parameters->{field}->[0];
661 =head2 $req->read( [$maxlength] )
663 Reads a chunk of data from the request body. This method is intended to be
664 used in a while loop, reading $maxlength bytes on every call. $maxlength
665 defaults to the size of the request if not specified.
667 =head2 $req->read_chunk(\$buff, $max)
671 You have to set MyApp->config(parse_on_demand => 1) to use this directly.
675 Shortcut for $req->headers->referer. Returns the referring page.
679 Returns true or false, indicating whether the connection is secure
680 (https). Note that the URI scheme (e.g., http vs. https) must be determined
681 through heuristics, and therefore the reliability of $req->secure will depend
682 on your server configuration. If you are serving secure pages on the standard
683 SSL port (443) and/or setting the HTTPS environment variable, $req->secure
686 =head2 $req->captures
688 Returns a reference to an array containing captured args from chained
689 actions or regex captures.
691 my @captures = @{ $c->request->captures };
693 =head2 $req->snippets
695 C<captures> used to be called snippets. This is still available for backwards
696 compatibility, but is considered deprecated.
700 A convenient method to access $req->uploads.
702 $upload = $c->request->upload('field');
703 @uploads = $c->request->upload('field');
704 @fields = $c->request->upload;
706 for my $upload ( $c->request->upload('field') ) {
707 print $upload->filename;
716 return keys %{ $self->uploads };
723 unless ( exists $self->uploads->{$upload} ) {
724 return wantarray ? () : undef;
727 if ( ref $self->uploads->{$upload} eq 'ARRAY' ) {
729 ? @{ $self->uploads->{$upload} }
730 : $self->uploads->{$upload}->[0];
734 ? ( $self->uploads->{$upload} )
735 : $self->uploads->{$upload};
741 while ( my ( $field, $upload ) = splice( @_, 0, 2 ) ) {
743 if ( exists $self->uploads->{$field} ) {
744 for ( $self->uploads->{$field} ) {
745 $_ = [$_] unless ref($_) eq "ARRAY";
746 push( @$_, $upload );
750 $self->uploads->{$field} = $upload;
758 Returns a reference to a hash containing uploads. Values can be either a
759 L<Catalyst::Request::Upload> object, or an arrayref of
760 L<Catalyst::Request::Upload> objects.
762 my $upload = $c->request->uploads->{field};
763 my $upload = $c->request->uploads->{field}->[0];
767 Returns a L<URI> object for the current request. Stringifies to the URI text.
769 =head2 $req->mangle_params( { key => 'value' }, $appendmode);
771 Returns a hashref of parameters stemming from the current request's params,
772 plus the ones supplied. Keys for which no current param exists will be
773 added, keys with undefined values will be removed and keys with existing
774 params will be replaced. Note that you can supply a true value as the final
775 argument to change behavior with regards to existing parameters, appending
776 values rather than replacing them.
780 # URI query params foo=1
781 my $hashref = $req->mangle_params({ foo => 2 });
782 # Result is query params of foo=2
786 # URI query params foo=1
787 my $hashref = $req->mangle_params({ foo => 2 }, 1);
788 # Result is query params of foo=1&foo=2
790 This is the code behind C<uri_with>.
795 my ($self, $args, $append) = @_;
797 carp('No arguments passed to mangle_params()') unless $args;
799 foreach my $value ( values %$args ) {
800 next unless defined $value;
801 for ( ref $value eq 'ARRAY' ? @$value : $value ) {
803 utf8::encode( $_ ) if utf8::is_utf8($_);
807 my %params = %{ $self->uri->query_form_hash };
808 foreach my $key (keys %{ $args }) {
809 my $val = $args->{$key};
812 if($append && exists($params{$key})) {
814 # This little bit of heaven handles appending a new value onto
815 # an existing one regardless if the existing value is an array
816 # or not, and regardless if the new value is an array or not
818 ref($params{$key}) eq 'ARRAY' ? @{ $params{$key} } : $params{$key},
819 ref($val) eq 'ARRAY' ? @{ $val } : $val
823 $params{$key} = $val;
827 # If the param wasn't defined then we delete it.
828 delete($params{$key});
836 =head2 $req->uri_with( { key => 'value' } );
838 Returns a rewritten URI object for the current request. Key/value pairs
839 passed in will override existing parameters. You can remove an existing
840 parameter by passing in an undef value. Unmodified pairs will be
843 You may also pass an optional second parameter that puts C<uri_with> into
846 $req->uri_with( { key => 'value' }, { mode => 'append' } );
848 See C<mangle_params> for an explanation of this behavior.
853 my( $self, $args, $behavior) = @_;
855 carp( 'No arguments passed to uri_with()' ) unless $args;
858 if((ref($behavior) eq 'HASH') && defined($behavior->{mode}) && ($behavior->{mode} eq 'append')) {
862 my $params = $self->mangle_params($args, $append);
864 my $uri = $self->uri->clone;
865 $uri->query_form($params);
870 =head2 $req->remote_user
872 Returns the value of the C<REMOTE_USER> environment variable.
874 =head2 $req->user_agent
876 Shortcut to $req->headers->user_agent. Returns the user agent (browser)
885 Catalyst Contributors, see Catalyst.pm
889 This library is free software. You can redistribute it and/or modify
890 it under the same terms as Perl itself.
894 __PACKAGE__->meta->make_immutable;